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Poner (ор а 555607 ot the Automated Data Processing 
equipment selection Office (ADP"SO) AYPO-COC3OL has been 
implemented on a microcomputer. The implementation provides 
merens bevel constructs and file options from the ANSI 
COBOL package along with the PERFORM UNTIL construct from a 
higher level to give increased structural control. The 
language was implemented througn a compiler and run-time 
package executing under the CP/M operating system of an 89080 
microcomputer-based system. BON the compiler and 
interpreter can be executed in 20K bytes of main memory. A 
program consisting of 8.5K bytes of intermediate code can be 
supported on this size machine. Modification of the compiler 
and interpreter programs can be accomplished to taze 
advantage of larger machines. The programs that make up the 
compiler and interpreter vackage require 39K bytes of 415 


storage. 
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Lo. INARODUGTI ON 


A. BACKGROUND 


The NPS MICRO-COBOL Compiler/Interpreter was initially 
(1976) developed to demonstrate that it was feasible to 
implement a COBOL compiler on a micro-computer. It was known 
that the COBOL language used would have to be a subset of 
ANSI COSOL because of the restriction imposed by the size of 
a micro-computer memory. A subset of ANSI COBOL, 
specifically ADPSO HYPO-COBCL, was selected as the basis for 
the implementation [3]. Additional motivation was provided 
by the DOD requirement that all computers used in a 
ron-tactical environment be capable of executing COROL. 

The previous work was directed toward five major areas: 
1.) selecting a suitable COBOL subset to operate on, 2.) 
develop the associated grammar for the language, 3.) 
determine what type of compiler to design, 4.) design and 
code the compiler, and 5.) design and code the interpreter. 
The interpreter performs the functions of a classical 
linking loader, resolving forward address references and 
establishing the run time intermediate code environment, as 
wWelleas, executing the intermedite code. 

The establishment of a suitable language was easily 
determined since HYPO-COBOL was a Devartment of the Navy 
approved subset of COFROL, designed to place minimal 


requirements on a system for compiler support. “here 





possible, short constructs were used in the place of longer 
mes. Where more than one reserved word served the same 
function іп COBOL the shortest form was used. There is no 
optional verbage in the language, and no duplicate 
constructs perform the same function. Limits were placed on 
all statements that had a variable input format so that all 
Statements had a fixed maximum length. Where possible, such 
constructs were removed completely from the language. 1л 
Buon, user defired identifier names were limited to 
twelve Characters to reduce symbol table storage 
requirements. 

Rather than include the Standard levels of 
implementation for all of the modules, constructs were 
included only as required. In addition to low level 
constructs, the PERFORM UNTIL construct was included to 
БЕКОШ ре ег program structure. Further justification for 
the manner of subsetting and a highly detailed description 
of each element of the language 15 contained in the 
ПОО ОСОБО а поџаве specifications reference 5. ‘For а 
Пре 5 ов or ErrO-CO30L constructs that are not supported 
by MICRO-CCBOL see appendix G. 

The grammar for the MICRO-COBOL language was defined as 
LALR(1). The compiler design was based on a table-driven 
parser for the LALR(1) grammar. The algorithm used to 
develope the parse tables for the compiler was developed by 
7. Lalonge [17]. 


The basic design and coding of the compiler and 





interpreter was completed prior to the current thesis work 
by Scott Allan Craig [2]. Modification to the original 


thesis work was conducted by Phil Mylet [15]. 


В. OPERATING ENVIRONMENT 


The МР5 MICRO-COBOL compiler and interpreter аге 
designed to run under the CP/M operating system on an 8989 
or 280 based microcomputer with at least 20K bytes of main 
memory. The compiler programs are designed to use no more 
than 12K bytes of main memory, while the interpreter program 
uses approximately 8K bytes. The compiler and interpreter 
require S@K bytes of disk storage for the programs that make 
up the compiler/interpreter package. For information on 
creating MICRO-COBOL source programs and CP/M see references 


4 and 5. 


C. GOALS AND OBJECTIVES 


The primary goal of this thesis project was to complete 
the implementation of an 8089 ПРО РОС Отоа based 
compiler/interpreter, which could compile and execute a 
subset of the ANSI Standard НА О 60 ВО language 
ШЕСІ ШІсСатоп. TO achieve this goal both the compiler and 
interpreter would require testing, debugging, modification 
and implementation (extension) of any necessary additional 
language constructs. It was also decided that while testing 


and debugging, the documentation of the compiler’s and 
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interpreter’s internal structures, memory organit тес Топ, 
interfaces and module functions would be accomplished. 

since the amount of testing and debugging effort could 
not be accurately determined, several subgoals were 
established which would be undertaken if adequate time was 
available. These time dependent goals included the 
validation of the compiler and interpreter and the inclusion 
of additional language CON structs not previously 
implemented. 

In addition to the above goals, it was considered 
beneficial to update and incorporate all previous thesis 
locumentation into the present NPS MICRO-COBOL conpiler and 
interpreter documentation. This documentation is appended to 


this thesis. 


D. PROBLEM DEFINITION 


For software performance assessment, a series of simple 
COBOL source programs and the Navy Automated Data Processing 
Zquipment Selection Office HYPO-COBOL validation test 
programs (80075) were compiled and execution was attempted. 
ШІ еџа ша ог о the test results indicated that the 
Сар ег ала interoreter could only compile and execute very 
Simple test programs. In Darticular, the compiler was unable 
t9 compile past the file section of the first validation 
program. 

A review of the compiler and interpreter documentation 


led 650 several additional conclusions. The compiler and 
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empre ter were difficult to understand, and pro@#am logic 
flow was hard to follow, because: 1.) modular functions were 
not explained well, 2.) documentation on the module 
interfacing was inadequate, 3.) complete specifications 
describing the internal structures and memory organization 
did not exist, and 4.) few comments were included within the 


Source code listings. 
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IM ПвзитТГокО СОФЫ СОМРЛЛАРО 


А. GENERAL DESCRIPTION 


The MICRO-CO80L compiler is a one pass compiler that 
scans and parses MICRO-CO30L source programs, and generates 
intermediate code (pseudo-instructions) for the interpreter 
(pseudo-machine). The scanner design is similar to most 
other scanner implementations. The parser is an  LALR(1) 
table-driven design, implemented in the PLM&8@ programming 
language [8]. The parse tables, as stated before, were 
generated using an algoritam developed at the University of 
Boronto [17]. 

The compiler reads the source program from a disx file, 
extracts the needed information for the symbol table and 
writes the pseudo-instructions to an intermediate code file. 
memaccomolish this function, the compiler consists of three 


moauless PART СМЕ, IREADER, and PAaT TWO. 


Eee 2  MBOL TABLE 


The symbol table is the key data structure in the 
пе ништиосгтајоп concerning {деп его, “Piles; “and 
records specified in the DATA DIVISION of the MICRO-COBOL 
Ace program is stored in the symbol ta 18, alone with 
labels specified in the PROCEDURS DIVISION. 


Fhessymbol table structure consists of: 1.) a simtuyePour 





address hash table, 2.) a fixed length field of thirteen 
bytes for each symbol table entry, and 3.) a variable length 
СІП to hold the name of each identifier. Since each 
identifier name 15 limited to twelve ASCII characters the 
symbol table entry for identifiers can vary in length from 
Enirteen to twenty-five bytes. The bytes of each symbol 
table entry are grouped into various fields of either one or 
two tytes depending on the storage requirements. The 
Шыг ееп bytes of the fired length field entry are numbered 
from zero to twelve and the variable length field begins 
with byte thirteen. In referencing a svecific field a byte 
imeem with a value from zero to thirteen is utilized. 

The symbol table entry for a single identifier could 
contain up to nine different attributes of that identifier, 
although not all identifiers required the full range of 
attributes. The various fields in the symbol table contained 
different information depending on whether, for example, an 
identifier was a numeric or alvdhanumeric type. Four of the 
же а contained the same information for all identifiers. 
These fields were: 1.) field zero (bytes zero and one ) 
contained the collision link, 2.) field one (byte two) 
contained the type of the identifier, 3.) field two (byte 
three) contained the length of the identifier name, amd +) 
field thirteen (byte thirteen) was the beginning of the 
ASCII character representation. It Should be noted that ak 
identifier of type FILL*R would not have a name associated 


ЖИЕН so field two would contain a zero and fierd 
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о гсееп would not erzist. 

satry roto the symbol table is accomplished by using a 
HASH function on the ASCII character representation of the 
identifier name. This function generates an even number 
between zero and 126. The number is used as an index into 
mre pasa table бу Specifying an offset Prom the base of "the 
hash table. The hash table can hold sixty-four uniquely 
песи теа adaress references to identifiers. The hash table 
entry associated with each index reference heads a linked 
ШЕП ОР identifiers with the same HASH function value. The 
linked list structure provides for additional identifier 
storage and therefore the number of uniaue identifiers is 
not limited by the sixty-four index values generated by the 
HASH function. A zero entry in the hash table indicates that 
ШЕШСЕ 15 10 identifier with that HASH function values In 
Пепин тошећ, the linked list of identifiers the most 
recently declared variable appears at the end of the list. 
See figure [11-1] for an example of the computation of a 
hash value. See figure [II-2] for and example of the hash 


table indexine and linking of hash values. 


pa 
O! 





HASH VALUE COMPUTATION 


16 


TASH Function value: sum of identifier ASCII characters 
loeically and with SFH then shifted left (SHEL) one bit. 
HASHBASE = 2000Н 
E.F.(48) » HASHBASE + SEL(( (41H + 42H) AND 3FE),1) = 20262 
H.F.(BA) = HASHBASE + SHL(((42H + 41H) AND 3FH),1) = 20068 
FIGURE II-1 
BASH TABLE, SYMBOL TABLE LINKING 
HASH SYMBOL 
TABLE TABLE 
Ena | 21288 тена | 
i | ЕСІГІН 
|---------- | 2126Е i КО ‚ <= 
| i | ВА | 1 
t ! i | | 
|---------- | 21248 RR | 22008 | 
a Е E _ | 
| 
- - - = | 
- - - - | 
__-=___-_-- | 20088 jc === | 
21FÜ0H | >>----------------- ==> ! collision} | 
|---------- | 2@206Н | link for | »»--1| 
3 E EN | 
i Ја |--—------- І 21708 
aaa To | 20008 
FIGURE II-2 





1. Numeric Values 


The symbol table entry for numeric values can 
contain up to seven attributes of the variable. These 
attributes are: 1.) identifier type, 2.) length of variable 
name 3.) beginning address of variable storage, 4.) numeric 
count (number of storage locations required by the 
identifier), 5.) level number, 6.) number of digits to the 
right of the decimal point, and 7.) the variable name. 
Figures [II-3] and [11-4] illustrate, respectively, the 
following two COBOL declarations: 

91 МОМ РТС 9(9). 


21 NUM PIC 9(6).999 OCCUZS 12 TIMES. 
2. Numeric Edit 


The numeric edit symbol table entry expands оп the 
numeric symbol entry and utilizes bytes eight and niae to 
hold the beginning address, in the constants area, of the 
edit field mask. This mask allowed for the insertion of the 
ко ом пе Characters into and output display of a numeric 
тег: fixed and floating: dollar  sizns, credit(CR) and 
debit(DB) signs, asterisk fill, Z character fill, and plus 
("+") and minus ("-") signs. It should be noted that an 
identifier with a numeric edit field value can not be used 


in an arithmetic statement. 
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NUMERIC SYMBOL TABLE ENTRY. 


(4E 55 4D) 


BYTE | SYMBOL TABLE VALUE 
PI A A E 
0-1 СОЛАИ БИ о link 
| (00 00) 
IE TEEN ПИ КЗЫ. с... 
! 
2 | type identifier 
| (19) 
————— 
> ı length of identifier 
! name (493) 
A A па и cS Lu 
ı beginning address 
4-5 ! of identifier 
| Storage (904 25) 
1 
3 с: Ша ос шаса и ы же 
6-7 ı length of identifier 
ı storage (089 00) 
Bean eee d um 
8-9 |! not used 
шысы ы ee ла 
19 | level entry (@1) 
pc oo A cu 
11 ! decimal count (00) 
E E ms 
12 ! occurances (429) 
ee 
13-15 | identifier name 
| 
| 
| 


91 NUM РІС 9(9). 
FIGURE [1-5 
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NUMERIC SYMBOL TABLE ENTRY WITH DECIMAL 
AND OCCURS CLAUSE 


91 NUM PIC 


> Ер > ee ee se а ЕФ ы» > ee O > > ы» чы» > es eee ee > O as O > а A am A A A с-ш» 


SYMBOL TABLE VALUE 


СОТ Ыс ОП link 
(09 2%) 


type identifier 
(10) 


length of identifier 
пате (05) 


beginning address 
of identifier stoms 
age (ØD 25) 


length of identifier 
storage (29 90) 


identifier name 
(48 55 4D) 


9(6).999 OCCURS 12 TIMES. 


FIGURE 11-4 
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5. Alpha or Alphanumeric 


The altha and alphanumeric symbol table entries 
appear similarly in the symbol table except for their tyoe 
fields. Six entries appear in the symbol table for these 
Edentiflers: 1.) identifier type, 2.) length of identifier 
name, 3.) beginning address of storage, 4.) number of 
storage locations required by identifier, 5.) level entry, 
and 6.) identifer name. Figure [II-5] illustrates an alpha 
pol table entry for the following identifier declaration: 


01 ALPHA PIC A(@). 


4. Alpha :dit 


The alpha edit Symbol table entry expends on the 
alpha and alphanumeric edit types and utilizes bytes eight 
and nine to hold the beginning address of the edit fieid 
mask. These mask fields, which are stored in the constants 
area of the pseudo-machine, contain the characters necessary 
(те Fan output so that, for example, slashes or bianxs 


can be interspersed in the display output. 
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ALPRA SYMBOL TABLE ENTRY 


BYTE SIMBOL TABER VALUE 

0-1 COLTS ОПТ 

(80 20) 
2 type identifier 

(08) 

5 length of identifier 
(85) 
beginning address 

4-5 of identifier 


storage (16 25) 


1 

Н 

| 

! 

| 

| 

1 

| 

! 

t 

| 

| 

| 

| 

! 

1 

| 

{ 

{ 

i 

6-7 | length of identifier 

I storage (P8 28) 
| 
! 
{ 
| 
Н 
{ 
| 
! 
{ 
! 
| 
! 
| 
! 
i 
l 
! 
! 
| 


8-9 not used 
010 — | level entry (21) | 
ШОО Mier ue 0-2 
/— 12 | mot used —— 0000 
^ 13-17 | identifier name ——— 


(41 50e 115 


01 ALPHA PIC A(8). 
SS 
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eae Ss 


NPS MICRO-COBOL was designed to support singly 
indexed tables. These tables are established by using an 
OCCURS clause with the PICTURE clause of an identifier. 1? 
an identifier is specified as a table the number of 
occurances of the table are placed in byte twelve of the 
symbol table entry for that identifier. The table identifier 
in COBOL 15 similar to the subdscrioted variable in other 
programming languages. For example, the statement, 31 NUM 
PIC 9(9) OCCURS 12 TIMES , generates the symbol table entry 


illustrated in figure [II-4]. 


6. Labels 


Labels generate the simplest of all symbol table 
Влтаве. only four or five attributes are associated with 
the label. The variability depends on whether the label is 
declared in the source program before or after the label is 
referenced by a GO or PERFORM statement. In the event a 
label is specified before a GC or PERTORM statement 
references it, the symbol tatle would contain the following 
1.) the type associated with label, 2.) the length of the 
identifier name, 3.) the address of the first intermediate 
eo@e instruction following the adpedrance cf the latel ia 
the source program (bytes four and five), 4.) the last 
executable instruction associated with the label ¡bytes 
eight and nine) This would be either the last e2x2cutadle 


instruction encountered before another label or the end of 
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the program., anid 5.) the label name. 

In the event a label is referenced by a GO or 
PERFORM statement before the label actually apoears in the 
code, the symbol table entry performs a different function 
than just indicating the beginning and ending of the 
paragraph associated with the label. The same symbol table 
fields are used, however their meanings are different. The 
type is set to the unresolved latel type of (0299). The 
label remains unresolved until the beginning and the ending 
addresses of the associated paragraph are determined. 

If a latel is referenced for the first time by a GC 
Statement the symbol table is initialized with the 
following: 1.) unresolved label type (@FFH), 2.) the address 
of the GO statement (the intermediate code would be BRN 20 
00 where the zeros indicate where the address of the label 
is to be backstuffed). See section III-D for specific 
explanation of pseudo-machine iostructions ОЕТ 
remainder о? the label entries would be the same except го 
entry is made for the last executatle instruction associated 
with the label. If an additional reference is made to the 
label by a subsequent GC statement the following action 
would occur: 1.) the current address (bytes four and five) 
would be placed in the branch address of the 50 Statement, 
2.) the address of this branch statement would 5e placed in 
БОСОГО ГТ and five of the symbol table 20фту. Tes 
procedure facilitates linking together all unresolved 


references to labels so that when the label are resolved the 
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correct branch address could be placed into the intermediate 
gode. 

Encountering a PERFORM statement before a label ais 
declared causes the following actions: 1.)bytes four and 
mere contain the address of the next byte of intermediate 
code following the PER intermediate code instruction, 2.)and 
bytes eight and nine contain the address of the third byte 
following the PER instruction. If a subsequent PERFORM 
statement is encounted before the label is resoived the two 
address fields in the symbol table would be copied to tne 
associated bytes following the most current PERFORM 
statement and the address of the first and third bytes 
MONO Wine the PER instruction would be copied into the 
Symbol table. It should be pointed out that any number of 
PSEFORM and GO statements can be specified before a label is 


resolved. 


7. Files 





The symbol table entries for files are the most 
ом to understand. The complexity of the entries is 
Bosne Way files and records are declared in а 
MICRO=COBOL program. The symbol table entry for a file 
consists of the following: 1.) byte two contains the type, 
2.) byte three contains the length of the file пате, 5.) 
bytes four and five contain the address in tne symbol tadle 
of the first @1 level record associated with the file, 4.) 


byes cement and nine contain the begbinigaeg address of the 
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mere control block and input/output buffer «for the file, 
(this would be the actual address in the data section of the 
pseudo-machine for the beginning of the 165 bytes associated 
with the file), 5.) if the file has a key entry associated 
with it (access via RANDOM or RANDOM RELATIVE) bytes ten and 
eleven contain the symbol table address of the access кеу 
variable, and 6.) the rest of the entry contains the file 
name. Figure [II-6] illustrates a file entry in the symbol 


table. 
8. Records 


This entry contains seven attributes of a recor. 
Three are the same as all other entries tyve, пате, and 
length of name. While the other four are: 1.) tytes four and 
five contain the initial storage address for the record, 2.) 
bytes six and seven contain the number of bytes of storage 
Мк шће гесога, 3.) bytes eizht and nine contain the symbol 
table address of the file associated with the record (this 
facilitates referencing the file when the record is 
псе). and 4.) byte ten contains the level entry for the 


record. 





FILE SYMBOL TABLE ENTRY 
SAMPLE SOURCE PROGRAM FILE DECLARATION 


DNPUTSOUTPUT SECTION. 
FILE-CONTROL. 
5 Бове ТРОНА ДАТ, 
ORGANIZATION RELATIVE 
ACCESS RANDOM RELATIVE NUM 
RSSIGN Cogkeorl Le 


cn 
O1 
гә 


Up coy Ge Gal alls 
SF 46 49 4C) 


BYTE SYMBOL TABLE VALUE 
A 2 cr uL o ee 
0-1 | Collison link 

2 | type file 
| (03) 
иы е Е un 
% | length оТ®РЇТе 
! name (605) 
——— oru - 
| symbol table 
4-5 address son tirse 
| 21 level record 
| (99 2E) 
) 
o nn 
6-7 | not used 
8-9 ! first address of 
NOS &. buffer 
TO PNIS 
Be EM г 
10-11 ! symbol table 
| address of? key 
| (ЭБЕТ) 
E. m oo соко du EE. 
12 ! not used 
| 
eee! oo eee НЕКЕ 
13-17 ! file name 
| 
| 
1 
1 
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C. COMPILER MCDULE PART ONE" 
1. Purpose 


This first module of the compiler performs several 
functions. First, it establishes the interface between the 
compiler and: 1.) the input source file (o? type 'CBL ), 2.) 
the output intermediate code file (of type CIN"), and 3.) 
pe IHEADER module which reads and passes control to PART 
TWO of the compiler. Second, it scans and parses the source 
program statements up to tne PROCEDURE DIVISION. Third, it 
generates output consisting of the symbol table entries 


(saved in memory) and data initialization intermediate code. 
Рот го] Actions 


Eyeezecuting the command COROL <source оговват», ке 


object code for PART ONE of the compiler is loaded into 


Lo 


iad 


b^ 


memory starting at 100H (if necessary this can be mod 


ct 


for different machines) by the CP/M operating system. 
Execution of PART ONE loads the program name associated with 
Mme source program into the input file contro: blocx located 
at 5CE. This allows the source program пате to be saved 
until actual source program compilation begins. 

МЕТ бе cortrol program, IRCRDSR, is moved to maak 
memory just below the BDOS (see reference 4 for an 
explanation of BDOS and other CP/M associated names). For 


example, using an INTEL Corporation 62% MDS microcomputer 


system with the CP/M operating system, the IRZADIR routine 


a 





is moved to high memory starting at 02102029 and continuing 
through 0DOFFH. This is done for two reasons: 1.) it allows 
the symbol table of the source program to begin at the next 
meeress following the object code for PART ONE, and 2.) 
places IREADER high enough in memory so that it is not 
destroyed by creation of the symbol table. See figures 
[II-7] and [{II-8] for illustrations of the PART ONE memory 
organization before and after the IREADER routine iS moved. 
The purpose of the [READER routine will be explained in tne 


next section. 
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Ер 
~ 


MEMORY CRGANIZATION BEFORE I8EADER ROUTINE MOV 


Top of Memory 


F220H 


m om am am cm m "AD ~ => => 


BDOS 


> о ap am a а о о > о Ва am 


| | | | 
| | t. | | 
| | 0) | | 
| | AN | 
Io | A I | 
| с | A | | 
| ~ | Е ! 
I» e | 
1 зоа і о | | 
оъ» | | | 
о | сло | G4 | | 
0) | x о | | 
a fa | | | 
«tj ао о | A | 
| 3 | | ! 
о) | оо | d | 
об! ll > | 
~ | но | с | | 
^ i EL. 


> — ow ew ST ew 8 8] ee ew а а ЕР «пу: sews GAUL dumm ЕВЕ cA, ee p арр ӘР 


У АМИН Бе Бо 
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MEMORY ORGANIZATION A 


>, 
Es 
© 
Е 
а) 
> 
+ 
О Hi n: 
со O сә m mi 
Сә Py CQ Ge со O 
O +A Q ы C 
fry E+ Aa CA A ©) 
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| | “ји | | | 
| а 0) +> | 
| © Q 4 | QI hs 
| Ql As] (~ | © | 1 
EX E AN 


e O ee  dAMD co düMP aue CARD SAND ңыз «сес ee ee ee ES ee ee ee sop AND cmm о Geo Um ы» END uoo CUP anas Cop ч» eee ee c am MAUER s 
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Next, the interface between the compile® and the 
input file <source program> and the output fibe 
«intermediate code file» is established. The input file 
control block associated with the source file is initialized 
and the input file is opened. The input file name is copied 
Bene output file control block (FCB) and if there is заг 
intermediate code file already residing on the disk, it is 
Шрасей. The output FCB is initialized and a file directory 
entry established for the new copy of the intermediate code 
ке. 

Prior to beginning the scanninz and parsing actions, 
EM 1:50 128 byte record of the input file is read into the 
Шоп buffer, located at 80H (default I/O buffer for CP/M). 
ihe scanner is primed with the first character of the input 
program, and scanning and parsing actions continue from this 
uut in PART ONE until the PROCEDURES DIVISION of the source 
program is encountered; at this time compilation Ше 


suspende]. 


3. symbol Table Entries 


Entries made in the symbol table by PAPT ONE will 
consist of all identifiers declared in the DATA DIVISION of 
ШИЕ ource program. By refering to tke Symbol Table Section 
above, an explanation may be obtained regarding tne  varicus 


types of symbol table entries. 





4. Irtermediate Code Generation 


Pseudo-instructions are written to tre intermediate 
code file for several different reasons while PART ONE is 
scanning and parsing the source presram. [пе "ЕРЕ 
intermediate code generated occurs when the INPUT-OUTPUT 
SECTION of a source program is nonempty. Within the FILE 
CONTROL PARAGRAPH of this Section. instructions are 
generated? to initialize the FCE for the file name associated 
with the SELECT statement. The name associated with the 
ASSIGN statement is placed in the FCB and is used in 
referencing the file on the disk. 

Two other instances of intermediate code generation 
occur in the WORKING STORAGE SECTION of a source program. 
Anytime a record or elementary identifier entry has an 
Eunted PICTURE CLAUSE, code to initialize the storaze 
beginning at the address specified in the formatted mask 
attribute of the symbol table entry will be written to the 
intermediate code file. When a record or elementary 
identifier entry has an associated numeric or попаџтегје 
VALUE CLAUSE, code to initialize the storage beginning at 
the address specified in the value location attritute of the 
Symbol table entry will be written to the intermediate code 
же, 

The final Pseusoeimstruction written to "тате 
termediate code file is the SCD instruction. Tas occurs 
when the parser parses the word PROCEDURE in the source 


Program; control is then passed to PART TWO and Compilation 
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continues. 


ә, Rarser Actions 


The actions corresponding to each parse step are 
explained below. In each case, the grammar rule that 15 
being applied is given, and an explanation of what program 
actions take place for that step has been included. In 
describing the actions taken for each parse step there has 
been no attempt to describe how the symbol table 15 
Constructed, what pseudo-instructions are generated or how 
the values are preserved on the stack. The intent of this 
et lon is to describe what information needs to be retained 
and at what point in the parse it can be determined. here 
no action is reauired for a given statement, or where tne 
Ву асђјоп is to save the contents of the to» of the stack, 
no explanation is given. Questions regarding the actual 
manipulation of information should te resolved by consulting 
the programs. 

ПИ aca ramo: 3= <id-div> <e-div> <d-div> PROCEDURE 
Reading the word PROCEDURE terminates the first 
part of the compiler. 

2 <id-div> ::= IDENTIFICATION DIVISION. PROGRAM-ID. 

<comment> . <auth> <dated <secd 

КО С ап с := AUTHOR . <comment> 

4 | <empty> 

5 <date> ::= DATE-WRITTEN . <comment > 

6 ı <empty> 
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7 <5ес> ::= SECURITY . comment» 


a 


| <empty> 


9 <comment> ::= <input> 


12 


put 


2 


15 


14 


ES 


p 


E 


19 


20 


en 
22 


ı <comnent> <input» 


<e-div> ::= ENVIRONMENT DIVISION . CONFIGURATION 
SECTION. 
<ser-obj> <i-o> 
<sre-obj> ::= SOURCE-COMPUTER . <comment> <debug> 
OBESOS COMPUTER. <comment> 

<debug> ::= DEBUGGING MODE 

set a Scanner toggle so that debue lines will be 

Berde 

| Сетрђу> 
Guo M INPUT-OUTPUT SECTION . FILE-CONTROL 
Кона от лош оса <> 
| Сетрђу> 
<file-control-list> ::= <file-control-entry> 
| <file-control-list> 
<file-control-entry> 

te con trol=entry> ::= SELSCT <1id> <atrribute-1list>. 

Маса о point all of the information about the "вије 

has been collected and the type of the file can be 

determined. File attrıbutes are checked for 

compatability and entered in the symbol table. 
канал ош те 1555> ::= <опе attrib» 

| «attribute-list» Cone attrib» 


<one-attrib> ::= ORGANIZATION <org-tyve> 
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25 


24 


ED 


26 


276 


28 


29 


52 
E 
32 


55 


55 
56 
on 


58 


| ACCESS <acc-tyve> <relative> 
| ASSIGN <input> 
НИ Comtrol Black is built for the file usine the 
INT operator. 
<ore=type> ::= SEQUENTIAL 
No information needs to be stored since the default 
file organization is sequential. 
| RELATIVE 
The relative attribute is saved for production 19. 
Сасс-Туре> ::= SEQUENTIAL 
iio the default. 
| RANDOM 
The random access mode is saved for production 19. 
<relative> ::= RELATIVE <id> 
The pointer to the identifier will be retained by 
tremecunrent symbol pointer, so this production only 
saves a flag on the value stacx indicating that the 
pooamerton did occur. 
| «empty» 
EU EE 1-O-CONTROL . <same=list> 


; <empty> 


<same-list> <same-element> 
I <same-list> <same-element> 
<same-element> ::= SAME <id-string> 
СОВИ Рэ %5:- <id> 
' <id-string> <id> 
КЕ = DATA DIVISION . <tile-section> <work> 





59 


40 


41 
42 
45 


44 


45 


<link> 
Кожа ес оп> :у= FILE SECTION . <fileslist> 
A flag needs to be set to indicate completion of 
the file section, so that the appropriate routine 
will be called when parsing level entries in the 
WORKING STORAGE SECTION. 
| <empty> 
The flag, indicated in production 39, is set. 
<file-list> ::= <file-element> 
| <file-list> <file-element> 
Nes TD <id> <file-control> 
<record-description> 
а-а спа цвлепо indicates the end of a record 
description, if there was an implied redefinition 
of the record, then the level stack (IDSSTACZ) 
must be reduced. The length o? the first record 
description and its address can now be loaded 
into the symbol table for the file name. 
<file-control> ::= <file-list> 
The address of the symbol table entry for the 
record describing the file пате 15 entere® into ал 
attribute of the file name symbol table entry, 
while the address of the file names symboi table 
entry is entered into an attribute of the same 
necord. 
| Сетрђу> 


Same as 44 above. 
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48 
49 


50 
5l 
52 
55 


эө, 


35 
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<file-list> ::= <f1ile-element) 


| <file-list> <file-element> 


ee element !‘:=—e@8L0CKe<integer> RBEOORDS 


ı RECORD <rec-count> 
The record length is saved for comparison with 
the calculated length from the picture clauses. 
¡ LABEL RECORDS STANDARD 
1- LABEL RECORDS OMITTED 
| VALUE OF <id-string> 


“Trec-coune> ::="<inteeer> 


| <integer> TO <integer> 
iimemosoption is the only indication that the file 
will be variable length. The maximum lenzth must ђе 


saved. 


<work> ::= WORKING-STORAGE SECTION . <record-description> 


If the level stack (IDSSTACK) contains a record 
identifier with a level number greater than one, 
ШЕШІ Не Stack must be redvced = The" reduction 
depends on whether the identifier on the top of 
the stack is a redefinition of the item beneath 
ior not. The primary action 1s to assign the 
proper amount of storage to the last record in 
the WORKING STORAGE SECTION. 


| <empty> 


«uu: = LINKWEE SECTION . <recomd-desenintion> 


1 <empty> 


<mecord@descriptiom> = <lewel-entry> 
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¡<record-description><level-entry> 


<level-entry> ::= <integer> <data-id> <redefines> 


<da ta-type> 
The symbol table address for the level entry 
identifier is loaded into the level stack 
(IDSSTACK). The level stack keeps track of the 
nesting of field definitions (elementary items) 
Mimcmnecord 20) the FILE and WORKING STORAGS 
SEIELEONS> At this point there may be no irfor- 
mation about the length of the item beine defined 
and its attributes may depend entirely upon its 
ense uent fields. within the FILE SECTION, 
multiple record descriptions for a file are 
assumed to be redefinitions of the first record 
description. Іп the WORKING STORAGE S*SCTION, 17 
there is a VALUE CLAUSE, the stack level to which 
1t applies is saved in PENDINGSLITERAL, the level 
entry number is saved in VALUSSLEVEL and a flag, 


VALUSSFLAG, is set. 


Pew odtamid ::= <14> 


63 


| FILLER 
An entry 15 built in the symbol table to record 
поета  јоп ађоџћ 6015 гесога #беја. Іс саппотаве 
udeserplicitly in a program because it has no пате, 
but its attributes will need to be stored as part of 


the total record. 


СОО crecdetines> 3: := REDEPINES <id> 
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The redefines option gives new attributes to a 
previously defined record area. The symbol table 
pointer to the area being redefined is saved in an 
attribute of the redefining identifier’s symbol table 
entry, so that information can be transferred to tne 
onea mpy elvuner Identifier, In addition to the Pnkorm- 
ation saved relative to the redefinition, it is nec- 
essary to check to see if the current identifiers 
level number is less than or equal to the level number 
of the identifier currently on the top of the level 
Macko lf this is true, then all information "or the 
item on top of the Stack has been saved and tre stack 
eee reaucead. If the current identifier is a redes- 
MO rot another identifier, tne stack entry for =the 
recordai pelag redefined 15 not removed until the first 
non-redefinition of a current identifier at the same 
level. 

| <emoty> 
As in production 64, the stack (IDSSTACK) is checked 
to determine if the current level number indicates a 
reduction of the level stack is necessary. In add- 
Mons recital action needs to ve taken if tae neg 
level is 01. If an 81 level is encountered at this 
production prior to production 39 or 48 (the end of 
the file area), it is an implied redefinition of the 
previous O1 level record. In the WORKING STORAGE 


SECTION, it indicates the start of a new record. 
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66 
67 
68 
69 


70 


ШІ 


72 


75 


<data-type> ::= <prop-list> 


| Сетрђу> 


<prop-list> ::= <data-element> 


| <prov-list> <data-element> 


<data-element> ::= PIC <input> 


Them input? at this point is the charactem string 
that defines record field. It is analyzed and the 
necessary extracted information is stored in the 
symbol table. 

| USAGE COMP 
The field is defined to a tinary field; however, 
COMP has not been implemented, therefore, if 
there is an associated VALUZ CLAUSZ, the value is 
entered into the associated identifier’s value 
storage location in display format. 

| USAGE DISPLAY 
The DISPBAY format is the default, and thus no 
weaclalzaetion occurs. 

! SIGN LEADING <separate> 
This production indicates the presence of a Siegen ia 
a numeric field. The sign will be in a leading 
position. If the <separate> indicator is true, 
then the length will be one longer than the PICTURE 
CLAUSE, and the type will be changed to signed 
numeric leading and separate. 

! SIGN TRAILING <separate)» 


The same information recuired by production 73 must 





CO 


76 


ae 


Cemrnecorced, Dut in his case the sign is trailing 
rather than leading. 

i; OCCURS «integer» 
The type must be set to indicate multiple 
occurrences and the number of occurrences saved 
for computing the space defined by this field. 

| SYNC <direction> 
Syncronization with a natural boundary is not 
required by this machine. 

| VALUE «literal»? 
The field being defined will be assigned an initial 
value determined by the value of the literal through 
the use of an INT operator. This is only valid in 
the WORKING-STORAGE SECTION. Note that numeric and 
Signed numeric PICTURZ CLAUSES will have a numeric 
-- no quotes delimiting —— VALUE CLAUSS, while 
alphanumeric and alpha types will have a nonnumeric 


== literal delimited with quotes — VALUES CLAUSE. 


ЕР Са ЕСТОЙ ::= LEFT 


79 
30 


S 


a2 


i RIGET 


! <enpty> 


<separate> ::- SEPARATE 


The separate sign indicator 15 set. 


| Сетрђу> 


cil teral> ::= <input> 


De input string is checked to see if it is a Баа 


numeric literal, and if valid, it is stored to be 


41 





used in a value assignment. 

84 о» 
This literal is a quoted string. 

85 | ZERO 
As the case of all literals, the fact that there 
is a pending literal needs to be saved. In tnis 
case and the three following cases, an indicator 
of which literal constant is being saved is 
all that is required. The literal value can be 
Reconstructed later. 

86 | SPACE 

87 | QUOTE 

88 «integer» ::- Xinput» 
The input string is converted to an integer value 
for later internal use. 

EXE АДУ = Input» 
Boe input string is the name of an identifier “ала 
is checked aginst the symbol table. If it is in the 
EE table, then a pointer to the entry is saved. 
Its not in the symbol table, them it is 


entered and the address of the entry is saved. 


D. INTERFACE ACTIONS 


When compilation is suspended in PART ONE of the 
compiler certain key variables are saved for use in PAR 
TWO. These variables are declared sequentially in PART ONE 


and are therefore located in contiguous memory in the 


+2 








Шагтавлве area of PART ONE. These variables consist of 
@evugeing toggles set when invoking thé compilé@r , i.e. 
sequence or token numbers, a pointer to the next available 
address in the symbol table, a pointer to the next character 
Mithe imput source file, the output file control block, the 
next address in the intermediate code area, the next address 
in the constants area, and the base address of the symbol 
table. These key variables, consisting of 48 bytes, are 
copied to the 48 bytes immediately below the [READER routine 
to спешге they are not destroyed when PART TWO of the 
compiler is brought into memory. Since the memory area 
required for PART ONE is larger than that required by PART 
TWO the symbol table does not need to be relocated. Since 
the symbol table is not altered when PART TWO of the 
compiler is brought into memory only the base address of the 
symbol table and the last address of the symbol ¡able need 
be saved to insure that access to the symbol table can be 
continued in PiRT TWO. See Figure [II-9} for an illustration 
of the memory organization when control is transfered from 
PART ONE to IREADER. The IFEADER rountine causes PART TWO of 
Гле ‘compiler to be brought into memory starting at 19@h amc 


Шен transfers control to PART TWO of the Compiler. 


COMPILER MCDULE "PART TWO 


lj 


ен DOS e 


<? 
LY 
(D 


The second part of the compiler scans and parses 





MICRO-CCBOL source statements starting with the PROCEDURE 


DIVISION and generates the necessary intermediate code. 
Peeeeoontrol Actions 


Hee first action after control is transfemed to ПШ 
TwO from the IREADER routine is to copy the 48 bytes o? the 
information saved from PART ONE into associated variables in 
PART TWO. After these variables are initialized all 
references to files, symbol table entries, etc. can te made 
in PART TWO and compilation can continue. See Figure [II-12] 
for an illustration of the memory organization at the time 


PART TWO begins compilation. 
3. Symbol Table Entries 
meee аи 


Entries made in the symbol table by PART TWO will be 
those for paragraph labels encountered within the PROCEDURES 


DIVISION of the source program. 
4. Intermediate Code Generation 


вал erplanation of the pseudo=instructions. rat 
are generated by PART TWO refer to the compiler program 
listings and the parser actions below. Also, for general 


mrformation on pseudo-instructions refer to secticn ІТГр. 
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57 


barser Actions 


ТИЕ” "ас%1005 сота сропііпое to 640% гаТсе 5Ф7Ет іп ВАЕТ 
TWO are explained below. In each case, the grammar action 
that is being applied is given, and an explanation of what 
program actions take place for that step has been included. 
In describing the actions taken for each parse 5:25 there 
has been no attempt to describe how the symbol table entries 
are made, what pseudo instructions are generated or how the 
values are preserved on the stack. The intent of this 
NEO is (0 describe what information needs to be retained 
and at what point in the varse it can be determined. Where 
no action is reauired for a given statement, or where the 
only action is to save the contents of the top o? the stack, 
no explanation is given. 
ШЕ С2-0117> ::= PROCEDURE DIVISION <using> 
<proc-body> EOF 

Пе Шо оса поени indicates termiiation= of =the 

compilation. If the program has sections, then 

it will be necessary to terminate the last section 

ишла нет @ instruction. The code will be ended 

Dehe output of a TER operation. 
a using? ::s USING <id-string> 

Not implemented. 
5 | Сетођу> 
4 <idestring> ::= <id> 

The identifier stack is cleared and the symbol 


table address of the identifier is loaded into 
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12 
11 
12 


15 


<paragraph> 


Bnesriırst stack location. 
| <id-string> <id> 
The identifier stack is incremented and the symbol 


table pointer stacked. 


<proc-body> ::= <paragraph)> 


| 


¡ <proc-body> <paragraph> 


<id> . <sentence-list> 


| 


The starting and ending address of the paragraph 
are entered into the symbol table. A return is 
emitted as the last instruction in the paragraph 
(RET @). When the label is resolved, it may be 
necessary to огодисе а BST operation to resolve 
previous references to the label. 

ic a> OSC TION.. 
The starting address for the section is saved. If 
it is not the first, then the previous 
section ending address is loaded and a return 
(RET @) is output. As in production £, a BST may 


be prođuced. 


<sentence-list> ::= <sentence>. 


! <sentence-list> <sentence> 


<sentence> ::= <imperative> 


| <conditional> 

ı ENTER <id> <opt-id> 
Не сове ге. 15 not implemented. Ап ENTER allows 
statements from another language to inserted in the 


source code. 








INS 


16 
17? 
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19 
20 


21 


pe 


25 


<imperative> ::= ACCEPT <subid> 


ACC <address> <length> 

ı <arithmetic> 

| CALL <1it> <using> 
This is not implemented. 

| CLOSE <id> 
CLS <file control block address> 

| <file-act> 

NDESPLAT <@ewt/id> <opt—11t/id> 
The display operator is produced for the first 
literal or identifier (DIS <address> «legeth» «$182»). 
If the second value exists, the same code is also 
produced forvit. The only difference inthe two 
we play outputs 1s the flaz is set to zero on tne 
first display to surpress the carriage retura ard 


line feed. 


| EXIT <program-1d> 


| GO <id> 
BRN <address> 
| GO <id-string> DEPENDING <id> 
Snes output, followed by a Aumber 0% Darameters: 
<the number of entries in the identifier stack> 
<the length of the depending identifier» <the 
address of the depending identifier> «the adiress 


of each identifier in the stack». 
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ПУКЕ І а> токена > 
The types of the two fields determine the move that 
STE ne rated, Numeric moves go through register two 
using a load and a store. Non-numeric moves depend 
upon the result field and may be either MOV, MED or 
MNE. Since all of these instructions have long 
parameter lists, they have not been listed in 
detail. 

| OPEN <type-action> <id> 
produces either OPN, 021, or OP2 depending 
upon the <type-action>. Each of these is followed 
ша је control block address. 

НЕ О ыста ВеО паев" 
The PER cperation is generated followed by the 
<branch address> <the address of the return 
statement to be set> and <the next instruction 
address). 

| <read-id> 

ı STOP <terminate> 
If there is a terminate message, then STD is 
produced followed by <message address> <message 


length». Otherwise STP 1s emitted. 


<conditional> ::= <arithmetic> <size-error> <imperative> 


operator 15. 0utput to complete the. tranca aroma 
the imperative from production 65. 
I <file-act> <invalid> <imperative> 


wS operator ls output to complete the rasen Trom 





production 64. 

Т t <le-nonterminal> <coadition> WEtiomd 

ELSE <imperative> 

NEG will be emmitted unless <condititon> is a 
"NOT <cond-type> , in which case the two negatives 
will cancel each other. Two 3ST operators are required. 
Шама tills sim the branch to the ZLS® action. Tke 
second completes the branch around the <imperative> 
which follows ELSE. 

52 ¡ <read-id> <suecial> <imperative> 
A BST is produced to complete the branch around the 
<imperative>. 

Beme<arithmetic> ::= ADD <1/id> <opt-1/id> TO <subid> 

<round > 

Шел тепсе Of multiple load and store instructions 
maxe it difficuit to indicate exactly wnat code will 
be generated for any of the arithmetic instructions. 
The type of load and store will devend on the nature 
of the number involved, and in each case the standard 
parameters will ђе produced. This parse step will ir- 
етен the following actions: first, a load will bde гете 
ишеш "Рог the first number into reester zero. IE 
there is a second number, then a load into register 
one will be produced for it, followed by an ADD and a 
STI. Next a load into register one will be generated 
tor the result number. Then ar ADD instrvctfom wall 


Besemnitted. Finally, if the round indicator Is se, а 


= 
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56 


S7 


58 


59 


42 


END operatcr will be produced prior to the store. 

DEVEDE <l/id> INTO <súbid> <round> 
The first number iS loaded into register zero. The 
sceomammoperand is loaded into register one. ХК DIV 
operato is generated, followed by a RND operator prior 
to the store, 1f required. 

| MULTIPLY <1/id> BY <subid> <round> 
The multioly is the same as the divide except that a 
MUL operator is generated. 

| SUBTRACT <l/id> <opt-1/id> FROM 

<subid> <round> 
Subtaction generates the same code as the ADD except 
that a SUB is produced ln piace of the last ADD. 
Сета ::= DELETE «id» 
Either a DLS or a DLR will be produced along with the 
reauired parameters. 
ERER ITE <11> 
wither a EWS or a RWR is emitted, followed by parame- 
ERSE 
| WR ied > «ресіа таат» 
Шеге аге four possible write instructions? w "Sl, 
ИЛЕ апа WRR. 
Сеи опо <= <lit> <not> <cond-type> 

Оше с? the compare instructions is produced.  Inew are 
ENS CNU, RCT, RLT, 350, 521, SLT, апак. 
Two load instructions and a SUR will also be generated 


tome of the register comtarisons is reoutren: 
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42 
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44 


45 
46 
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NUMERIC 


<cond-type> 
| ALPHABETIC 
| <compare> <lit/id> 
Sot? ::- NOT 
NEG 1s emitted unless the NOT is part of an IF 
Statement in which case the NEG in the I? 
Statement is cancelled. 
¡ <empty> 


<compare> ::= GREATER 


¡ EQUAL 
ROUNDED 


<ROUND> 


¡ <empty> 


| 


<terminate> <literal> 
| RUN 


<invalid> 


Крас ан > 3: 
ı END 
An ERO operator is emitted followed ty a zero. The 
zero acts as a filler in the code and will be bacx- 
Sed ta a branch address. In this producticn 
and several of the following, there is a forward 
branch on a false condition past an imperative action. 


Moran example of the resolution, exanime production 52. 


Copter > = <subid> 
| <empty> 
<action> = <imperative) 
BRN £ 
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62 
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ӘЗ 


| NEXT SENTENCE 
BRN 2 
bio... THRU <id> 
| <empty> 
КЛИО» 2:- <1/1d> TIMES 
LDI «address» <length> D&C Ø 
UNTIL «condition; 
¡ <empty> 
таах = INVALID 
INV @ 
Scmzemerror> ::= SIZE ERROR? 
SER Ø 
<special-act> ::= <when> ADVANCINS <how-many> 


ı <empty> 


ii 
td 
[=] 
До 
> 

О 

aj 


еп» :: 


<how-many>::= <integer> 


| I-0 
ЕО -= <омросг:оћ> 
acid 
Ginbecer> 2:= <input> 
ЗЫ эпо of the input String 15 Saved as an легат 
number. 
Се болов: 
Tre identifier is cnecked aginst the Symbo: table, if 


it is not present, it is entered as an unresolved? 


с 
> 





ад 


81 


85 


84 


(D 
D 


ве 
29 


99 
О: 
92 


label. 
ІІ input» 
The input value may be a numeric literal. If so, it 
is placed ın the constant area with an INT operand. 
ЕИО а опет с literal, then it must be ап 
Meni ier, and it is located in the symbol table. 
ЕБЕ рУ 
| ZERO 
БӘШШЕСЕШІРІ>» 75 <14> ( <input> ) 
If the identifier was defined with a USING ovtion, 
Meine, input string is checked to see if it 19 а 
Мишела dentifier. If it 15 an identiiler, 
Иепе SCR operator is produced. 
Ugo ::- <1/14> 
| <empty> 
ЛАУ clit» 
Неш eral string is placed into tne constant катеа 
ШЕНІ ап INT operator. 
| SPACE 
| QUOTE 
ШО ШОГАТ 2:- <an-lit> 
E пр? 
Пен аи value must be a numeric literal to be valid 
En um -Ncdded into the constant area using an INT. 
| ZERO 
api ::- <1/id> 
! <nn-lit> 


Or 
O! 









22 


112 /33> Иа > 


¡ <empty> 
сргостат-ій> ::= <id> 

| Сетрђу> 
Wnead-id» ::- READ <id> 


There are four read operations: RDF, RVL, RRS, and 


RAR. 


“1 –-повбегт]јла12::=[2 





ELI. ZNBSEEHWERO-COBOL TATER PRIOR 


A. GENERAL DESCRIPTION 


The following sections describe the NPS MICRO-COSOL 
pseudo-machine in terms of the implementation, memory 
pueanization, interface actions and interpreter 
Me tructions. The oseudo-machine,wwhich 16 constructed in 
the transient program area of CP/M, is the target machine 
for the compiler and is implerented through a programmed 
interpreter. Тһе interpreter decodes each operation and 
elther calls subroutines to perform the required actions or 
Hoc g3mectiyson the run time environment to control the 
weeds оі the interpreter. All communications between 
instructions is done through common areas in the program 
where information can be stored for later use. See figure 
[11 1-1] for an Ме Ега јол of the pseudo-machine 
Breanization. 


е тас е cöntains a program counter and multiple 


%) 


purametepr operations which contain all fhe information 
Aedo perform one complete action required by the 
language. Three eighteen digit registers are used ‘for 
папе operations, alone with a subscriot stack used to 
Amo te surscriot locations, and a set of flags are used to 
ПЕН information from ore instruction to aioi em., 


Addresses in the vseudo-machine are represented by 16 


bit values. Any memory address greater than 2d hexidecimal 


о? 





moe Valid. Addresses less than 22 hexidecimal will be 
interpreted as having Special significance. For example 
EDUUBeS Ses опе through eight are reserved for subscript stack 
references. All other addresses in the machine are absolute 
adresses. 

The registers allow manipulation of signed numbers up to 
eisehteen digits in length. Included in their representation 
is a sign indicator and the position of the assumed decimal 
point for the currently loaded number. Numbers аге 
represented in standard CCEOL "Display format. These 
numbers may have separate signs indicated by + and - ог 
may have a zone indicator, denoting a negative sign, in 
the most significant byte of a number’s storage location. 
Before operations occur on any numter, it is converted to a 
packed decimal format and entered into ore of the 


pseudo-machine registers. 


B. MEMORY ORGANIZATION 


ШИЕ ІЭШОГУ ОТ the pseudo-machine is divided into Eee 
menor areas: 1.) the data area is established by the DOTA 
НИКИТЕ ТОМ statements of the source program, 2.) the constant 
area which is established by both the DATA and PROCEDURE 
DIVISIONS of the source program, and 3.) the code area which 
established by the PROCEDURE DIVISION. 

The data area is the lowest area in the pseudo-machine. 
Mis tarea contains the storage for identifiers declared in 


Пен DATA DIVISION. Additionally, the data area contadas the 


Cn 
0D 


f 
| 





File Control Block (FC3) and the buffer space (128 bytes) 
for all fıles declared in the source program. 

Immediately following the data area is the code area. 
This contiguous area of storage contains all executable code 
generated. The constants area is located in high memory of 
the pseudo-machine. This area contains all edit field masks 
as well as all numeric and non-numeric literals. Figure 
[111-1] is rates the memory organization of the 


pseudo-machine. 
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C. INTERPRETER INTERFACE 


The interpreter consists of two interface routines and 
the main interpreter program. To execute the interpreter tae 
command EXEC <filename.filetype>, (where file type is CIN), 
is typed at the terminal. This action causes tne two 
Mmererrace routines, BUILD and INTRDR, to be brought into 
memory. See figure [III-2} which illustrates the memory 
organization immediately after BUILD and INTRDR have beer 
copied into memory. The BUILD routine reads in тле 
internediate code, initializes all memory locations 
requiring initalization, and resolves all unresolved address 
references. The INTRDR routine reads the inter;reter program 
Шо memory and transfers control to the interpreter 
program. 

The intermediate code instructions fall 1109 auo 
eetecories: 1.) instructions used by BUILD to establish the 
mime time environment and, 2.) instructions to be executed by 
the interpreter. The followins for instructions Gere 
seperated in the compiler for use by the BUILD routine; SCD, 
ENS BST, and TER. 

HUE start code) instruction is the last instruction 
generated by PART ONE and indicates where tne пре 
КУ ОО ЛШ instruction for the intermediate code is to be 
Шей This corresponds to the address immediately 
following the data area in the pseudo-machine. >22 Tisure 
[III-1] which illustrates the relative location of the 


ВИСЕ that is associated with the SCD instruction. 
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MEMORY 
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ORGANIZATION AFTER BUILD AND INTRDR 


HAVE BEEN LCADED INTO MEMORY 


Base of #005 


Free Memory 


RUILD ROUTINE 


мы ала ата 
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278008 
Top of Memory 


001203 


1903 
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The MUR (initialize) instruction Causes tre BOUE) 
ле to initialize the data area with the values 
associated with those identifiers in the DATA DIVISION of 
meee source program that had VALJE CLAUSES. In addition, the 
NN instruction causes the BUILD routine to initialize the 
constants area with all the edit masks for those identifiers 
of the numeric and alphanumeric edit type, and all literals 
encounted in the PROCEDURE DIVISION of the source program. 

The BST (backstuff) instruction resolves all unresolved 
ЕЕ ЕГЕПСЕ5, i.e. branches to labels defined after (пе 
respective PERFORM ог GO statement was encountered in the 
source program. 


The TER (terminate) instruction is the last instruction 


fa 


zenerated by PART TWO of the compiler and indicates the en 


tj 
(41 
ет) 


of the intermediate code file. Upon encountering a 
Mist ruction in the intermediate code the BUILD routine 
werts a ST? instruction in its place. The ST? instruction 
will cause the interpreter to terminate interpretation of 
the program when encountered. 

(осе code generated by the compiler is cosile¢c 1200 
the code area of the pseudo-machine ty the BUILD routine. 
See Figure [III-3] for an illustration of the memory 
wean zation at this point in the initialization routine. 
Mercal action taken by the 3UILD routine is tc move ` the 
ШОО ОЕ routine into the input buffer at EOS and transfer 
eOntro: to INTRDR. This frees the area from 1@@H to the base 


обе data area for the interpreter. 
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Паша пок гоџтуле reads the interpreter program into 
memory starting at i1@@H and transfers contol to it. From 
this point on the interpreter program executes the 


intermediate code that was loaded into the pseudo-machine. 


E+ 





MEMORY ORGANIZATION AFTER INTERMEDIATE CODE IS 
LOADED INTO MEMORY AND BEFORE THE INTSRPRETER 


IS LOADED 
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D. PSEUDO-MACHINE INSTRUCTIONS 


ЕЛІ 5 5ес оп briefly covers the pseudo-machire 
Bmertructions used іп the interpreter, their format, and the 


actions which they accomplish. 
1. Format 


Me ле interpreter instructions consist of an 
misuructlon number followed by a list of parameters. The 
eow ng sections describe the instructions, list the re- 
quired parameters, and describe the actions taken by the 
ел пе in executing each instruction. In each case, parame- 
ters are denoted informally by the parameter name enclosed 
Шешогаскето. The BRN branching instruction, for example, 
uses the single parameter <oranch address> which ls thes ае = 
Bey of the unconditional branch. 

As each instruction number is fetched from memory, 
the program counter is incremented ody one. The program 
enner 15 then either incremented to the next instruction 
number, or a branch is taken. 

The three eighteen digit registers which are used by 
the instructions covered in the following sections are re- 


ferred to as registers zero, one, and two. 
2. Arithmetic Operations 


There are five arithmetic instructions which det 
ШІП 6 three registers. In all cases, the resmlt 1s 


Ссей іп register two. Operations dre allomed to destroy 
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ие input values during the process of creating a result, 
therefore, a number loaded into a register is not available 
for a subsequent operation. 

ADD: (addition). Sum the contents of reeister zero 
and register one. 
Parameters: no parameters are required. 

SUB: (subtract). Subtract register zero from register 
one. 
Parameters: по varameters are required. 

MUL: (multiply). Multiply register zero by register 
one. 
Parameters: no parameters are required. 

DIV: (divide). Divide register one by the value in 
Meeisver zero. The remainder is not retained. 
Parameters: по parameters are recuired 

RND:(round). Round register two to the last signifi- 
cant decimal place. 


Parameters: no parameters are required. 
7 cRarening 


The machine contains the following flags which are 
ЕЕС une conditional instructions in this section. 

BRANCH flag -- indicates if a branch is to be taken; 

Ene ON ECORD ¿laz == 17141 са Тез лат ап end or 
input condition has been reached when ar attempt was made 
to read input; 


OVERFLOW flag -— indicates the loss of information 
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from a register due to a number exceeding the available 
Size, 

INVALID flag. -=-= indicates an invalid actiom ig 
miting to a direct access storage device. 

All of the branch instructions are executed by 
changing the value of the program counter. Some are uncon- 
ditional branches and some test for condition flags which 
are set by other instructions. A conditional branch is exe- 
cuted by testing the branch flag which is initialized to 
false. A true value causes a branch by changing the pro- 
gram counter to the value of the branch address. The branch 
[eae 15 then reset to false. A false value causes the pro- 
gram counter to be incremented to the next sequential in- 
srruetion. 

BRN: (branch to an address). Load the program 
ШП ЕГ with the <branch address». 

Parameters: <branch address> 

The next three instructions share a common format. 
The memory field addressed by the <memory address> is 
checked for the <address length>, and if all the characters 
Match the test condition, the branch flag is complemented 
Parameters: <memory address> <address length» «branch ad- 
dress> 

CAL: (compare alphabetic). Compare a memory field 
tor alphabetic Characters. 

CNS- (compare numeric signed). Compare a field for 


numeric characters allowing for a sign character. 
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CNU: (compare numeric unsigned). Compare a field for 
numeric Characters only. 

DEC: (decrement a counter and branch if zero). 
decrement the value of the <address counter> by one; if the 
result is zero before or after the decrement, the program 
counter is set to the <branch address>. If the result is 
not zero, the program counter is incremented oy four. 
Parameters: <address counter> <branch address> 

EOR: (branch on end of records flag). If the end- 
ENSrecords flag is true, it is set to false and the progmam 
counter is set to the <branch address>. If false, the pro- 
gram counter is incremented by two. 

Parameters: <branch address> 

GDP: (go to - depending on). The memory location ad- 
dressed by the <number address> is read for the number of 
bytes indicated by the «memory length». This number indi- 
cates which of the €branch addresses» is to be used. The 
first parameter is a bound on the number of branch ad- 
dresses. If the number is within the range, the program 
counter is set to the indicated address. An cut-of-bounds 
value causes the program counter to бе advanced to the next 
sequential instruction. 

Parameters: <bound number - byte> <memory length> <memory 
less)». <«branck addr-1> <braach addr-2> .om <drameh габат ар 

INV: (branch if invalid-file-action flag true). If 
the invalid-file-action flag is true, then it is set to 


ИИ Еа the program counter is set to tue »ramch ad= 





dress. If it is false, the program counter is incremented 
by two. 
Parameters: <branch address» 

PER: (perform). The code address addressed by the 
<change address> is loaded with the value of the <return ad- 
dress». The program counter is then set to the “branch ad- 
dress». 

Parameters: «branch address» <change address> «return ad- 
dress»? 

RET: (return). If the value of the <branch address> 
is not zero, then the vrogram counter is set to its value, 
аш пе < branch address> is set to zero. If the <branch ad- 
dress» is zero, the program counter is incremented by two. 
Parameters: <btranch address> 

meee (resister equal). This instruction checks for a 
zero value in register two. If it is zero, the branch flaz 
is complemented. A conditional branch is taxen. 

Parameters: <branch address> 

RGT: (register greater than). Register two is 
Eaxecked for a negative sign. If present, the branch flag is 
complemented. A conditional branch is taken. 

Parameters: <branch address> 

RLT: (register less than). Register two is checked 
Йа 52518175 siga, and if present, the branch flaz is com- 
КИСЕП еа А conditional branch is taken. 

Parameters: <branch address> 


SER: (branch on size error). If the overflow flae2z is 
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meee, (Леп the program counter is set to the branch address, 
Erbe overflow flag is set to false. If it is false, then 
the program counter is incremented by two. 
Parameters: <branch address> 

The next three instructions are of similar form in 
that they compare two strings and set the branch flag if 
me condition is true. 
Eupemneters: <string addr-i> <string addr-2> <lenegth - ad- 
dress?» branch address> 

SEQ: (strings equal). The condition is true if the 
Strings are equal. 

SGT: (string greater than). The condition 15 true if 
string one is greater than Strirg two. 

EON string less than). The condition is true if 


String one is less than string two. 
4. Moves 


The machine supports a variety of move operations 
more various formats and types of data. It does not support 
direct moves of numeric data from one memory field to anoth- 
er Instead, all of tre numeric moves go through the regis- 
ters. 

The next seven instructions аі! perform the same 
Fonction. They load a register with a numeric value and 
КОСО ОПТУ in the type of number that they expect To see in 
memory at the «number address». All seven instructions 


cause the program counter to be incremented by five. Their 
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common format is given below. 
Parameters: <number address> <byte leneth> <byte decimal 
count> <byte register to load> 

LOD: (load literal). Register two is loaded with a 
constant value. Mer decimal point indicator is not gtr in 
this instruction. The literal will have an actual decimal 
point in the string if required. 

рі: (load numeric). Load a numeric field. 

502: (load postfix numeric). Load a numeric field 
with an internal trailing sien. 

LD3: (load prefix numeric). Load a numeric field 
with an internal leading sign. 

LD4: (load separated postfix numeric). Load a numer- 
ic field with a separate leading sign. 

1р5: (load separated prefix numeric). Load a numeric 
field with a separate trailing sign. 

LD6: (load packed numeric). Load a packed numeric 
ied, 

MED: (move into alphanumeric edited field). The 
edit mask is loaded into the <to address> to set up tne 
move, and then the <from address> information is loaded. The 
program counter is incremented by ten. 

Parameters: <to address> <from address> «length o? move) 
<edit mask address> «edit mask length» 

MNE: (move into a numeric edited field). First the 
еони таски 1s loaded into the receiving field, and then the 


information is loaded. Any decimal point alienment required 





псе регтогтес. If truncation of significant digits is a 
Side effect, the overflow flag is not Set. The program 
counter is incremented by twelve. 

Parameters: «to address» <from address> <address length o? 
move> <edit mask address> <address mask length> <byte to Ae- 
cimal count> <byte from decimal count> 

MOV: (move into an alphanumeric field). The memory 
ОШО А  ziven by the <to address> is filled by the from field 
for the <move length> and then filled with blanks in the 
MOON An positions for the «fill count». 

Parameters: <to address> <from address> address move 
length> «address fill count» 

STI: (store immediate register two). The contents of 
register two are stored into register zero and the decimal 
count and sign indicators are set. 

Bememeters; none. 

The store instructions are grouped in the same order 
as the load Instructions. Register two sS stored nto 
memory at the indicated location. Alignment is performed 
and any truncation of leading digits causes the overflow 
ас антене. Al) five of the store Lastructions cause 
E xo-pame counter to be incremented by four.  Tie format 
о лезе instructions 1s as follows. 

Parameters: «address to store into» «byte length» «byte de- 
Сопат count» 
STO: (store numeric). Store into a numeric field. 


ST1: (store vostfix numeric). Store into a numeri 











ша, ап ілтегпа1 trailing sign. 

572: (store prefix numeric). Store into a numeric 
with an internal leading sign. 

ST3: (store separated postfix numeric). Store into a 
mumeric field with a sevarate trailing sign. 

ST4: (store separated prefix numeric). Store into a 
numeric field with a separate leading sign. 


ST5: (store packed numeric). Store into a packed 


numeric field. 
3 Input-Output 


DucwroPowine "instructions verform input and outmut 
operations. Files are defined as having the following 
emaracteristics: they are eitner sequential or random 
and, in general, files created in one mode are not required 
ЕСЕ readable in tne other mode. Standari files consist 
er fixed length records, and variable length files need not 
be readable in a random mode. further, there? TUS be 
Some character or character string that delimits a veriable 
memeto record. 

ACC: (accept). Read from the system 12aput device 
memory at the location given by the <memory address>. The 
program counter is incremented by three. 

Parameters: <memory address> <byte length of read» 

Mase (close). Close the file whose file control 

block is addressed by the <fcb address>. The Drogram counter 


15 incremented by two. 
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Parameters: <fcb address» 

DIS: (display). Print the contents of the data field 
Dointed to by <memory address> on the system outout device 
for the indicated length and advance the line output if 
<flag> is set. The program counter is incremented by four. 
Parameters: <memory address> <byte length> <fla2> 

There are three open instructions with the same for= 
mat. In each case, the file defined by the file control 
block referenced will be opened for the mode indicated. The 
program counter is incremented by two. 

Parameters: <fcbt address> 

OBN: (open a file for input). 

Oe) (oven a file for output). 

OP2: (open a file for both input and output). This 
is only valid for files on a random access device. 

The following file actions all share the same for- 
mat. Each performs a file action on the file referenced by 
ШЕН) 12 control block. The record to be acted upon is 
Piven by the <record address). The program counter Is in- 
cremented by six. 

Parameters: <TCB address> <record address> <гесога јепг,ћ - 
address>. 


DLS: (delete a record from a sequential file). 
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move the record that was just read from the fil 
is required to be open in tbe input-output mode. 
RDF: (read a sequential file). Read the next record 


into the memory area. 
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WTF: (write a record to a seavential file). Append a 
new record to the file. 

RVL: (read a variable length record). 

WVL: (write a variable length record). 

RWS: (rewrite sequential). The rewrite operation 
writes a record from memorv to the file, overlaying the last 
record that was read from the device. The file must be open 
Ша tne input-output mode. 

The following file actions require random files 
rather than sequential files. They make use of a random file 
pointer which consists of a<relative address> and a <re- 
lative leneth>. The memory field holds the number to be 
used in disk operations or contains the relative record 
number of the last disk action. The relative record number 
is an index into the file which addresses the record being 
accessed. After the file action, the program counter 
is incremented by nine. 

Parameters: <FCB address> <record address> <record length - 
address> <relative address> <relative length - byte». 

DLR: (delete a random record). Delete the record ad- 
dressed by the relative record number. 

RER: (read random relative). Read a random record 
relative to the record number. 

RRS: (read random sequential). Read the next sequen- 
tial record from a random file. The relative record aumber 
of the record read is loaded into the memory reference. 


RWR: (rewrite a random record). 


76 








WRR: (write random relative). Write a record into 
the area indicated by the memory reference. 

WRS: (write random sequential). Write the next 
sequential record to a random file. The relative record 


number is returned. 


See Special Instructions 


Dhecremaining instructions perfomm specthal fumetices 
еј гед by the machine that do not relate to any of the 
Previous groups. 

NEG: (negate). Complement the value of the branch 
flag. 

Parameters: NO parameters are required. 

LDI: (load a code address direct). Load the code 
address located five bytes after the LDI instruction with 
the contents of <memory address> after it has been converted 
memenexidecimal. 

Parameters: <memory address> <lenzth - byte) 

Sem (calculate a subscript). Load the subscribt 
Stack with the value indicated from memory. The address 
Medea into the stack is the «initial address> plus ап 
offset. Multiplying the <fieid length> by the number in the 
¿memory reference» gives the offset value. 

Parameters: <initial address> <field length> <memory refer- 
ence» «memory length? &stacx level; 

STP: (stop display). Display the indicated informa- 


tion and then terminate the actions o? the machine. 





Parameters: <memory address> <length - byte> 

Bae. (Stop) . Terminate the actions of the machine. 
memameters; no parameters are required. The following in- 
structions are used in setting up the machine environment 
and cannot be used in the normal execution of the machine. 

EST: (backstuff). Resolve a reference to a label. 
Labels may be referenced prior to their definition, reauir- 
ing a chain of resolution addresses to be maintained in the 
pode, The latest location to be resolved is maintained in 
the symbol table and a pointer at that location indicates 
the next previous location to be resolved. А zero pointer 
miemeates No prior occurrences of the label. The code ad- 
dress referenced by <change address> is examined and if 
it contains zero, it is loaded with the <new address). If 
it is not zero, then the contents are saved, and the 
process is repeated with the saved value as the change ad- 
Mess after loading the {new address)». 
Parameters: <change address> <new address> 

Plies initialize memory). Load memory with the <in- 
put string» for the given length at the &memory address». 
Parameters: <memory address> «address length> «feu 
sering> 

start code). Set the initial value о: the Dro- 
aram counter. 
Parameters: start address» 

TER: (terminate). Terminate the initialization Dro- 


cess and start executing code. 
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meters: no parameters are required. 








IV. SYSTEM DERUGGING METHODS AND TOOLS 





Initially it appeared that the debuzging of the compiler 
ЕНІ interpreter would be straight forward. However, it 
became apparent that a systematic approach would have to Бе 
adopted in order to meet the objectives. AS previously 
stated, the first step was to determine the degree to which 
the compiler had been developed. After accomplishing this 
Ex the next step was to identify tne means oy which 
errors could be located and the methods by which solutions 
could be implemented and tested. 

Илеана ос исосеа to identify errors within the .compiler 
eons sted ОҒ the following: 1.) compillnz test orograms aad 
denoting any compilation errors and 2.) examination of tre 
ОООО table construction and intermediate code instructions 
Zenerated by compiling through the DATA DIVISION of a source 
program. 

А minimum of forty-five minutes was required to 
Becompile either module -- PART ONS or PART TWO -- of тз 
compiler after making changes, because the object code 
produced bY the compiler had to be linked and loaded. fris 
Mag@icated a need to find and use an alternative appDrcach for 
testing proposed changes. The approach used, was to test 
compiler and interpreter modifications by using interactive 
debugging tools before changing the compiler's source code 


and recompiling. This reduced the amount of time that would 
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EUESrwise have been required by reducing the total number of 


recompilations. 


ШЕ ТҮЕЗГССІМС METEODOLOGY 


МЕ се бшеејтпе methodology utilized, consisted o* stems 
similar to those sugzested by Polya’s problem-solvinz 
technique [16]. First, upon encountering an occurrence of an 
Бог, the approach was to understand wry the error 
Meemrred. This included determining what the compiler or 
Mererpreter had done right in its compilation or execution 
of a source program, followed ty an analysis of what the 
Ember or interpreter rad done incorrectly. Second, a 
theory was devised to explain the nature of the еггог(5), 
along with a devised metnod, such as a paper and vencil wale 
Шит саап using e erent variables ор” combina IE 
e ables, to confirm the theory. Next, the plan concerning 


the error was implemented, usually this was accomplished >: 


“3 
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a paper and pencil code walk Shrowen followed 
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Meeompitation and  reexecution of the program. Finally. 
Мог was determined, reviewed, and implemeatec. 
It was observed, as in other program debugging efforts, 


(а few errors gave nost of the difficulties encountened 


cv 


when debugging. Upon several occasions, it was thought tha 
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ИШ ОГ 1п and el) side effects of an error hed be 
discovered; later however, after havine made a substantial 
ООШ спапсе, it was realized that there was either another 


ВО ату condition, circumstance or combinatorial problem 
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Bs rise to the error. The result was that of hatine to 
осу and refix the error, which required additional time 
and effort. 

Powtacilitate the testing and debugging of the compiler 
and interpreter several different software tools were 
ШИ еа It Is difficult to say which was the most 
beneficial; however, when they were used together the task 


of testing and cebuezing was significantly enhanced. 


ШЕ INTERACTIVE TCOLS 


Because the MICRO-COBOL compiler and interpreter were 
implemented under the CP/M operating system, two CP/M 
debugging facilities were used. First, the Dynamic Debugging 
Tool [7], DDT, is a dynamic interactive program which allows 
testing and debugging of programs in the CP/M overation 
system environment. The second was the Symbolic Instruction 
Debueger [6], SID, which exvands upon the features of DIT. 
Æ cifically, SID includes real-time breakpoints, fully 
BHenctored execution, symbolic disassembly, assembly, and 
memory display and fill functions. Both debuggers were 
designed to operate in an interactive mode and each had 
several features and facilities in common which enhanced tre 
debugging ffort. One feature which allowed the setting of 
Mreakvoints at actual nemory locations corresponding to 
program's source lines and symbolic names was used quite 
ӨПЕпезуеіу, Another useful facility was the ability Ко 


ola апа alter the programs symbolic values, which 
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enabled the substitution of valves to check а proposed 


solution to an error. 


C. CROSS REFERENCE LISTINGS 


Another useful facility which eased the debugging effort 
EIDEM Me cross reference listings troduced by the PLMeg 
Eumprler used to compile the MICRO-COBOL compiler amd 
ШО оге ег. There were three different listings produced 
mover €ach compilation: 1.) a line numbered source listing, 
2.) a symbol address table, which included the name and 
actual memory address assigned for all symbols leclared, and 
3.) a line address table which cross referenced every line 
in the source listing with the 8050 code generated by the 
Eu) compiler for that varticular line. These listings were 
almost indispensable with regard to testing and debugging. 


EXMULhel» contribution cannot be overemphasized. 


Bee VALIDATION TESTS 


ОЕШ отпес of this thesis project it agas very 
meus cult to decide how to test various constructs and 
features of the MICRO-COBOL compiler and interpreter and 
Were were questions regarding test case desiza. "During 
earlier work [1°], the HYPO-COBOL Compiler Validation System 
(HCCVS) Tape (from the Automated Data Processing заці этеп: 
Selection Office (ADPESO)) was acquired -- to be used in 


Кита the MICRO-COBOL compiler. However, the 3CCVS Pas 
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never used and the tape had not been transferred to the 
Ao prorriate media, This transfer was accomplished later 
[12]. Зу using the HCCVS as the evaluation package, the 
questions regarding test case construction and design were 
resolved and testing proceeded. The 40075 was used primarily 
as a test bed for PART ONE of the compiler, having as ап 
objective the goal of ensuring the prover construction of 
the symbol table and data initialization. Because some of 
the EYPO-COBOL constructs were not implemented in the 
MICEO-COBOL compiler (see Appendix E), the compilation of 
any HCCYS program past the PRCCZDURE DIVISION statement was 


not successful. 
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V. CONCLUSIONS AND RECOMMENDATIONS 


А Significant portion of the MICRO-COBROL 
Compiler/Interpreter has been tested, debugged and 
documented. The following specific language features and 
facilities previously not implemented, or implemented 
incorrectly, have been successfully implenented, tested and 
Embuesed during this project: 1.) the compiler's ability to 
handle any sequence of MICRO-COBOL language constructs 
(PICTURE CLAUSE, VALUE CLAUSE, OCCURS CLAUSE, and USAGE COMP 
AMUSE) in the declaration of an identifier, 2.) record 
identifier declarations with up to ten levels of elementary 
field items, 3.) record and elementary field identifier 
redefinitions, 4.) nested redefinitions, and 5.) error 
message generation for duplicate identifier declarations 
within tne DATA DIVISION. 

Testing and debugging has teen accomplished for all 
presently implemented 5035200) 5015 language cons ucts 
EScurring cae DATA DIVISION? or а source proazren. 
specifically, testing was performed by compiling through the 
Dress oT YDSION of the first ten HCCVS test огоггат5. 

тиши бг, the MICRO-COBOL compiler has been 
completely documented. This documentation includes the 
following: 1.) module organization, 2.) module interfaces, 
3.) memory organization of the Interpreter, 4.) construction 


w дата initialization of the symbol table, and 5.) key 
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internal data structures. 

several areas remain which could be improved, develoved 
and implemented, to enhance the MICRO-COBOL 
Compiler/Interpreter system, these include: 1.) correction 
ШІ (пе numerical algorithms in the interpreter to allow for 
signed-fractional arithmetic, 2.) implementation of numeric 
editing capabilities, 3.) implementation of а printer 
control feature and interface, and 4.) testing and debugging 
of the compiler's ability to compile the PROCEDURE DIVISION 


of the HCCVS test programs. 
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I. ORGANIZATION 


The compiler is designed to run on an 8088 system in an 
interactive mode through the use of a teletype or console. 
It requires at least 24K of main memory and a mass Storaze 
device for reading and writing. The compiler is composed of 
meee parts , each of which reads a portion of the input file. 
Part One reads tne input program to the end of the Data 
Mision and builds the symbol table. At the end of the Data 
Mvision, Part One is overlayed by Part Two which uses tne 
Symbol table to vroduce the code. The output code is written 
as it is produced to minimize the use of internal storage. 

The BULD Program builds the "core пете for the 
intermediate code and performs such fuictions as 


Backstuffing addresses. BUILD then loads the INTERPRETER 
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addresses. BUILD then transfers control to the INTRD 
moutine. The INTRDR routine copies the interpreter into 
Memory and transfers control to the Interpreter. The 
NUN erpreter is controlled by a large case statement that 
decodes the instructions and performs the recvired actions. 
As a tool for debugging the compiler the DECODE Program 
was created; it reads the intermediate code file ani 
eenas lates the instructions into mnemonics followed dy 


parameters. 
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PI Mies CORCL ELEMENTS 


This section contains a description of each element in 
the language and shows simple examples of their use. The 
following conventions are used in explaining the formats: 
Elements enclosed in broken braces < > are themselves 
complete entities and are described elsewhere in the manual. 
Elements enclosed in braces ( } are choices, one of the 
elements which is to be used. Elements enclosed in brackets 
( ] are optional. All elements in capital letters are 
reserved words and must be spelled exactly. 

User names are indicated in lower case. These names have 
een restricted to 12 characters in length. There is only 
Breuer ion On User names, the first character must be 
an alpha character. The remainder of the user name can have 
any combination of representable character in it. 

The inout to the compiler does not need to conform to 
Standard COBOL format. Free form input will be accepted as 
the default condition. If desired, sequence numbers can be 
entered in the first six positions of each line. However, а 
toggle needs to be set to cause the compiler to ignore tne 


sequence numbers. 
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[IDENTIFICA MON BIVIS DOs 


EIBMENT: 


IDENTIFICATION DIVISION Format 


FORMAT: 


IDENTIFICATION DIVISION. 


PROGRAM-ID. «comment». 


(AUTHOR. <comment>.]) 


[DATE-WRITTEN. <comment>.] 


[SECURITY. <comment>.] 


DESCRIPTION: 
Po l S OOTO Vides information for program iden- 
Сат ПТ е reader. The order of the lines 15 
fixed. 

EXAMPLES: 
POENTE CATION DIVISION. 


PROGRAM-ID. SAMPLE. 


BUSHOHZEMICHARTL-L-RICE,. 
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ENVIRONMENT DIVISION 


ELEMENT: 


ENVIRONMENT DIVISION Format 


FORMAT: 


ENVIRONMENT DIVISION. 


CONFIGURATION SECTION. 


SOURCE-COMPUTER. <comment> [DEBUGGING MODS]. 


OBJECT-COMPUTER. <comment>. 


(INPUT-OUTPUT SECTION. 


EDPDESOONTPOL. 


<file-control-entry> 


[I-0-CONTROL. 


SAME file-name-1 file-name-2 [file-name-3] 


[file-name-4] [file-name-5]. ] | 


DESCRIPTION: 
This division determines the external nature of a 
file. In the case of CP/M all of the files used can 
be accessed either sequentially or randomly excest for 
variable length files which are sequential only. The 


debugging mode is also set by this section. 
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<file-control-entry> 


ELEMENT: 
<file-control-entry> 


FORMAT: 


SELECT file-name 
ASSIGN implementor-name 
[ORGANIZATION SEQUENTIAL] 


[ACCESS SEQUENTIAL]. 


SELECT file-name 
ASSIGN implementor-name 
ORGANIZATION RELATIV? 
[ACCESS {SEQUENTIAL [RELATIVE data-name]}]. 
{RANDOM RELATIVE data-name } 


DESCRIPTION: 
The file-control-entry defines the type of file that 
the program expects to see. There is no difference on 
Beyemarsette, but tae type of reads and writes that 


are performed will differ. For CP/M the implementor 
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mame needs to conform to the normal specifications. 
EXAMPLES: 
SELECT CARDS 


ASSIGN CARD.FIL. 


SELECT RANDOM-FILE 


ASSIGN A.RAN 


ORGANIZATION RELATIVE 


ACCESS RANDOM RELATIVE RAND-PLAG. 








DATA TEN INSSISQN 


ELEMENT: 


DATA DIVISION Format 


FORMAT: 


DATA DIVISION. 


EILE SECTION. 


(FD file-name 


[BLOCK integer-1 RECORDS] 


(RECORD [integer-2 TO] integer-3] 


[LABEL RECORDS (STANDARD?) 


[OMITTED ) 


(VALUE OF implementor-name-1 literal-1 


[inplementor-name-2 literal-2] ... ]. 


(<record-description-entry>] ...] ... 


[WORXING-STORAGE SECTION. 


[<record-description-entry>] ... | 


(LINKAGE SECTION. 


(<record-description-entry>] ... ] 














DESCRIPTION: 

This is the section that describes how the data is 
Structured. There are no major differences from stan- 
deamdmemoooOL "except for the following: 1 Label 
records make no sense on the diskette so no entry is 
required. 2. The VALUE OF clause likewise has no 
meaning for CP/M. 3. The linkage section has not been 
implemented. 

If a record is given two lengths as in RECORD 12 TO 
128, the file is taken to be variable length and can 
only be accessed in the sequential mode. See the sec- 


tion on files for more information. 
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comment > 


ELEMENT: 


<comment > 


FORMAT: 


any string of characters 


DESCRIPTION: 


Beeonment Isa string of characters. It may include 
anything other than a period followed by a blank ora 
reserved word, either of which terminate the string. 
Comments may be empty if desired, but the terminator 
is still required by the program. 

EXAMPLES: 


this is a comment 


anctheroneallruntogether 


50895 165 






<data-descrinvt i on=amtry> 


ELEMENT: 


Caata-@eschiotion-entry> Format 


FORMAT: 


level-number ídata-name] 


[FILLER } 


[REDEFINES data-namel 


[PIC character-string] 


(USAGE {COMP y 


(DISPLAY) 


[SIGN {LEADING} [SEPARATE]] 


{TRAILING} 


[OCCURS integer] 


ИЧЕ ет |] 


[RIGHT] 


[VALUE literal]. 


DESCRIPTION: 


Mais statement describes the specific attributes of 


the data. Since the 8087 is a tyte machine, there was 
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NO Meaning to the SYNC clause, and thus it as not 
been implemented. 

EXAMPLES: 
01 CARD-RECORD. 


ОРНРАВА ПРЕС X(5). 


02 NEXT-PART PIC 99V9O9 USAGE COMP. 


O TRILLER. 


23 NUMB PIC S9(3)V9 SIGN LEADING SEPARATE. 


05 LONG-NUMB 9(15). 


ШЕТ ЗЕВЕКІМ%5 LONGCNUMBOPICESOIS)S 


МЕРКЕ PIC 99 OCCURS 109. 
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PROCEDURE DIVISION 
ELEMENT: 
PROCEDURE LIVISION Format 
FORMAT: 
Il 
PROCEDURE DIVISION [USING name1 [name2] ... [пате5]1. 
= ишоа- дате. 5: 07107. 


[paragraph-name. <sentence> [<sentence> ... ] ... | 


PROCEDURE DIVISICN [USING namel [{name2] ... {name5]}. 
paragraph-name. <sentence> [<sentence> ...!] ... 


DESCRIPTION: 
ши по cated, if the program 15 to contain sec- 
(О then the first tarazraph mvst be іл а section. 
Попе ои 02010п 15 part of the interprosram communi- 


cation module and has not been implemented. 
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<sentence> 


ЕПГҮТТЕМІ: 


<sentence> 


FORMAT: 


<imperative-statement> 


<conditional-statement> 


ENTER verb 


DESCRIPTION: 
All sentences other than ENTER fall in one of the two 
main catigories. ІНГЕН 15 Dart 0% tae 1 nterproenam 


communication module. 
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<irperative-statement)> 


ELEMENT: 


<imperative-statement > 


FORMAT: 


The following verbs are always imperatives: 


ACCEPT 


CALL 


CLOSE 


ШІ БАТ 


ЕХІТ 


GO 


MOVE 


OPEN 


PERECRM 


STOP 


The following may be imveratives: 
aritnmetie verbs without the Slas ER SCR statement 


Seep sLets, @MRITE, and AWAITS without the INVALID 9009 2П. 
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<conditional-statements> 


SLEMENT: 


<conditional-statements> 


FORMAT: 


IF 


PEAD 


aritametic verbs with the 512% ERROR statement 


and DELETE, WRITE, and REWRITE with the INVALID option. 








ELEMENT: 


ACCEPT 


FORMAT: 


RECEPT <identifier)> 


DESCRIPTION: 
This statement reads up to 255 characters from the 
console. The usage of the item must бе DISPLAY. 
EXAMPLES: 


ACCEPT IMMAGE 


ACCEPT NUM(S) 
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ADD 


ELEMENT: 


ADD 


FORMAT: 


ADD {identifier} [{identifier-1}] TO identifier-2 


{literal } {literal } 


[ROUNDED] [SIZE ZFROR <imperative-statement>| 


BRSCRIPTION: 
ususenstruction adds either one or two numbers то a 
undo with the result being placed in tne last loca- 
tion. 

EXAMPLES: 
ADD 1% TC NUMB1 


Pete ОТО 2 ROUNDED. 


ADD 192 TO NUMBER SIZE ERROR GO ERROR-LOC 
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ELEMENT: 


CALL 


FORMAT: 


CALL literal [USING namel [name2] 


BESCHRIPTION: 


CALL is not implemented. 


[named] | 





ELEMENT: 


CLOSE 


FORMAT: 


CLOSE file-name 


BESCHIPTION: 
Files must be closed if they have been written. EOw- 
ever, the normal requirement to close an input file 
prior to the end of processing does not exist. 
EXAMPLES: 
CLOSE FILE 


OUOST RANDFILE 
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PLEMENT: 
DELETE 
FORMAT: 


DELETE file-name [INTALIT <imperative-statement>] 


EUSCPIPTION: 
This statement requires the file-name of t^e item 
to be deleted. The record is logically removed by 
CMAR naet with a high value character, which is not 
соштеше а 01е to tae console or line printer. Ihs log- 
ical record space car be used again by writing a 
DES тес га in its place. 

NANO LES : 


poss TILESNAME 
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DISPLAY 
ELEMENT: 
DISPLAY 
FORMAT: 
DISPLAY {identifier} [[identifier-1}] 
{literal + dliteral } 


ESSOSITPTICN: 
Ia drsplays the contents of an identifier or 
displays a literal on the console. Usage must be 
ДИ Ае пахјтуот lenzth of the display is 22 char- 
acters for ıiteral values and 255 characters for 
ШЕШ теле Опіу %ы0 ійеп%1?тет5/117ега15 аге 
allowed for each DISPLAY command. 

A AMPLIS: 


ШВӘРГАТ Г555125-1 


Peewee MEooAGE-3S 12 


laj 

taj 

1 
N 


pM TEILS MUST BE TH 


To 






DIVIDE 


FORMAT: 


DIVIDE {identifier} INTO identifier-1 [ROUND=D] 


{literal } 


[SIZE ERROR <imperative-statement >|] 


mes CR IPTION: 
ПОШ сз ШОШО tae division is stored in ildentifiersi,; 
any remainder is lost. 

EXAMPLES: 


DIVIDE NUMS INTO STORE 


DIVIDE 25 INTO RESULT 
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ELEMENT: 


ENTER 


FORMAT: 


ENTER language-name [routine-name] 


DESCRIPTION: 


ШЕШЕ ош госе 15 not implimented. 


LIT 





A SMENT: 


EXIT 


Ber MAT : 


EXIT [PROGRAM] 


DESCRIPTION: 
The EXIT command causes no action by the interoreter 
PU осе tor an empty paragraoh for the construction 
common return point. The optional PROGRAM state- 
Ос сло implemented as it is part of the interpro— 
Zram communication module. 

A AMPLES: 


RETIN. 


taj 


POE 
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ELEMENT: 


GO 


FORMAT: 


1. 


GO procedure-name 


GO procedure-1 [procedure-2] ... procedure-22 


DEPENDING identifier 


MS CAI2TICN: 


ШЕ СО command causes an unconditional braacn to the 


routine specified. The second form causes a forward 


branch depending on the value of the contents of the 


aaentitier. The identifier must be a numeric intezer 


value. There can be no more than 2 procedure names. 


EU sAD-C0 n5. 


GO READL READ2 READS DEPENDING READ-INDSX. 
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ri 
3 


ELEMENT: 


TUM 


FORMAT: 


IF «condition» [imperative } ELSE ımverative-2 


{NEXT SENTENCE} 


DESCRIPTION: 
This is the standard COBOL IF statement. Note а 


there is no nesting of IF statements allowed since the 
Ie Statement is a conditional. 


BRAMPLES: 


Ш SNDSPOS-ADD A TO C ELSE GO ERPOR-ONE. 


ME QICDISUMSRICONEXT SSZNTENUOZ xL5* “OVS ZERO TO AS 
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ELEMENT: 
MOVE 
FORMAT: 
MOVE {identifier-1} TO identifier-2 
{literal } 


DXSCEIPTION: 


The standard list of allowable moves applies to 


action. AS a Space saving feature of this implementa- 


TOM wale numeric moves eo through the accumulators. 


This maxes numeric moves slower than alphka-numeric 


moves, and where possible they should be avoided. 


noeh nvolvesecpicture clauses that are exactly 


the same can be accomplished as an al2ha-numeric 

if the elements are redefined as alpha-numeric; 

all group moves are alpha-numeric. 
EXAMPLES: 


NOV CR TO PRINT-LINE. 


uu ee 





MULTAELY 


ELEMENT: 
MULTIPLY 


FORMAT: 


MULTIPLY {identifier} BY identifier-2 (ROUNDED] 
{literal } 
[SIZE @RROR <imperative-statement >| 


DESCRIPTION: 
The multiply routine requires enougn space to calcu- 
late the result with the full number of decimal digits 
ПОП ОШОЛ ле the result into  identifler-2. This 
means that a number with 5 places after the decimal 
multiplied by a number with 6 places after the decimal 
will generate a number with 11 decimal places which 
would overflow if there were more than 7 digits before 
the decimal place. 

BZAMPLSS: 


ШЕЛЕРІ ВУ T. 


КОШ ТВ 8(7) SIZES ERROR GO OVs2FLOW. 
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ELEMENT: 


OPEN 


FORMAT: 


OPEN {INPUT file-name } 


{OUTPUT file-name} 


(1-0 file-name } 


DESCRIPTION: 
The three types of OPENS have exactly the same effect 
on the diskette. However, they do allow for internal 
cues ner ne other file actions. Тот example, a 
же сем 9 oa file set open as input will cause a fatal 
Ser Or. 

AMPLES: 


O PENEINPUT CARDS. 


ПЕН UTPUT HXPORT-—-TILE. 


Qu 











2PH LORM 


ELEMENT: 


PERFORM 


FORMAT: 


ШЕ 


PERFOEM procedure-name [TERU procedure-name-2] 


PERFORM procedure-name (THRU vrocedure-rame-2] 
{identifier} TIMES 


{integer } 


PERFORM procedure-name [TERU procedure-name-2] 
UTIL condition» 


EXSSCRIPTION: 


All three options are supported. 
and the procedures called 


Branching may be ei- 


ther forward ог  beckward, 


may have perform statements in them as lona as the end 


pomucdosnot ocohnocide or overlap. 


EXAMPLES: 
HECUNOSRMOOPSN-RCUTINE. 


11E 








А А АОЛ ЛАО Sis ТАКО END=REPORT. 


PERFORM SUM 19 TIMES. 


ОЕР ИМЕ UNTIL PG-CNT GREATER 60. 








ELEMENT: 


READ 


FORMAT: 


I; 


READ file-name INTALID <imperative-statement> 


READ file-name END <imperative-Sstatement> 


DESCRIPTION: 
Mea ias condition is only aplicable to files in a 
random mode. All sequential files must have an END 
Sete men ve 

EXAMPLES: 
READ CARDS END GO END-OF-FILE. 


АИ ВА ПРОМЕТ INVALID MOVES SPACES TO REC-1. 
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REWRITE 
ELEMENT: 
REWRITE 


FORMAT: 


REWRITE record-name [INVALID <imperative>] 


DESCRIPTION: 
Dank ysconly valid for files that are oper іп the 
Дете The INVALID clause is only valid for random 
AI OS ta tement results in tne current record 
being written back into the place that it was just 
read from, the last executed read. 


EXAMPLES: 


xj 


IND INVALID PERYORM ERROR-CHECZ. 
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SROP 
ELEMENT: 
ДОР 
FORMAT: 
STOP {RUN } 
{literal} 


DESCRIPTION: 
This statement ends the runnine of the interpreter. 
If a literal is specified, then the literal is 
displayed on the console prior to termination of the 
program. 

EXAMPLES: 


oTOP RUN. 
Sucre 1. 


STOP "INVALID #1М158. 
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S'UBITTNCT 


ELEMENT: 


DU one T 


FORMAT: 


ОШО et identitier-1+' lidentifier-2] FROM identifier—s 


[literal-1 } [literal-2 ] 


(ROUNDED! (SIZE ERROR <imperative-statement>] 


DESCRIPTION: 
Identifier-3 is decremented by the value of 
identifier/literal one, and, ie specie 
identifier/literal two. The results are stored back 
КІ eae ntitier-5, Rounding and size error options аге 
available if desired. 


EXAMPLES: 


Seman Ones FROM SU3(12). 


ЕИ ОВ FROM С ROUNDED. 





FORMAT: 


T3 


WRITE record-name [[BZFORE) ADVANCING {INTEGER}] 


{AFTER } {PAGER } 


WRITE record-name INVALIT <imperative-statement> 


DESCRIPTION: 
Шен тасога syecitied iS written to the file 
Spec edi tne file section of the source 
program. The INVALID option only applies to 
mena ome: 1les . 

EXAMPLES: 


ARDRE QUT-FILE: 


KO RONO FILE INVALID PERFORM ERROR=RECOY. 


ОПАО > 


«Сола tion 


FORMAT: 


RELATIONAL CONDITION: 


{identifier-1} [NOT] {GREATER} [identifier-2} 


{literal-1} ESS } fliteral-2 } 


{EQUAL } 


ПАЗ CONDITION: 


identifier [NOT] {NUMERIC } 


ARIAS ELLO 


DESCRIPTION: 
ООО Пп valia to compare two literals. The. class 
eon aA OnT NUMERIC will allow for a Sign if the iden- 
Кели о о Јеплеа пџитег1с. 

EXAMPLES : 
A WOT LESS 14. 


НИКЕ C. 


[А] 


LIN 


NUMEL NOT NUMERIC 
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SUES crip tans 


ШЕМЕМТ: 


Ses cripting 


FORMAT: 


data-name (subscript) 


DESCRIPTION: 
Any item defined with an OCCURS may be referenced by 
e oe ecri pt. Tha subscript may be a literal integer, 
or it may be а data item that has been specified as an 
integer. I? the subscript is signed, the sign must be 
positive at the time cf its use, 

EXAMPLES: 


A(10) 





DIILOOMPLESR. TOGGIES 


There are four compiler toggles which are cortrolled by 
an entry following the compiler activation command, COBOL 
<filename>. The format of the entry consists of following 
<filename> by one space and then entering a 5 followed 
immediately by the desired togeles. There must be only one 
space after «filename» and no spaces between the “$ and the 
toggles. The following is an example of a typical entry: 

COBOL EXAMPLE 557 
Mies. entry would cause the compiler to ignore the sequence 
numbers entered at the beginning of each input file line and 
ЕНІП tne token numbers to the output device. In each case 


the toggle reverses the default value. 


SL -- 115% the input code on the screen as the brogram 
Mmemcompiled. Default is on. Error messages will be difficult 
 Шігететалйа If this toggle is turned off, but if the 
interface device is a teletype, it may be desired in certain 


situations. 


SS -- sequence numbers are in the first six positions of 


eeemerecord. Default is off. 
SP -- list productions as they occur. Default is off. 


$T -- list tokens from the scanner. Default is of??. 





IV. RUN TIME CONVENTIONS 


This section explains how to run the compiler on tne 
current system. The compiler expects to see a file with a 
type of CBL as the input file. In general, the input is free 
form. If the input includes seauence numbers then the 
compiler must te notified by setting the appropriate toegle. 
mee compiler is started by typirg COBOL <?і1е-пате>. Where 
the file name is the system name of the input file. There is 
mor interaction required to start the second part of the 
compiler. The output file will have the same <file-name> as 
mie input file, ard will be given a file type of CIN. Any 
previous copies of the file will be erased. 

The interpreter is started by typing EXEC «filename». 
mae first program is a loader, and it will display LOAD 
FINISHED to indicate successful completion. The run-time 
package will be brought іп by the INTRDR routine, and 


execution should continue without interuption. 






NS LR INTERACTLONS WITH CP/M 


The file structure that is expected by the program 
imposes some restrictions on the system. References 4 and 5 
contain detailed information on the facilities of CP/M, and 
Euculd be consulted for details. The information that has 
been included in this section is intended to explain where 
Штаба 1005 exist and how the program interacts with the 
System. 

Ali files in CP/M are on a random access device, and 
there is no way for the system to distinguish sequential 
meres irom files created in a random mode. This means that 
the various types of reads and writes are all valid to any 
file that has fixed length records. The restrictions of the 
ASSIGN statement do prevent a file from being open for both 
random and sequential actions during one program. 

Each logical record is terminated by a carriage return 
seem а line feed. In the case of variable leneth records, 
bo1S 1S the only end mark that exists. This convention was 
adopted to allow the various programs which are used in CP/M 
Шон work with the files. Files created by the editor, for 
example, will generally be variable length files. This 
convention does remove the capability of reading variable 
leneth files ir a random mode. 

All of the ohysical records аге 122 bytes in length, and 
the Drozram sucplies buffer space for these records in 


ШОП (92 the logical records. Logical records may be of 
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BR 


CL 


MA 


MO 


OP 


50 


ST 


DI 


VI. ZERRORSMISShGES 


A. COMPILER FATAL MESSAGES 


Bad read -- disk error, no corrective action can ђе 


taken in the program. 


Moe eerror ~ unable to close the output file. 
AO Could not create the output file. 
Memory overflow -- the code and constants generated 


will not fit in the alloted memory space. 

емо Б can not open the input file, or no suck 
file present. 

Stack overflow -- the LALR(1) parsing stack has exceeded 
its maximum allowable size. 

oymbol table overflow ~- symbol table is too large for 
the allocated space. 

Memuemenrors-- disk error, could not write a code 


тесога "То the disk. 


BOONE LLENA ING 


Close error -- attempted to close a non-existiae file. 
Pemma count errar == decimal significance is greater 
CAQULS As 


Duplicate identifier -- the identifier name has been 


Tol 





ID 


15 


[T 


LV 


MD 


MS 


NF 


previously declared in the WORKING STORAGE area of the 
program. 

Bxcess files -- the number of files declared in the 
source program exceeds 24. 

Extra levels -- only 18 levels are allowed. 

File type -- the data element used in a read or write 
statement is not a file name. 

Invalid access —— the specified options are not an 
allowable combination. 

len stack overflow —- more than*22 items “im а 
c0 TO -- DEPENDING statement. 

ПОИ КОВО ОТЕ == ап item was  subscripted but 1% 
was not defined by an OCCURS. 

ИШ КНИГ Үе the field types do not match for this 


statement. 
Literal error а literal value was assigned to an 
item that is part of a group item previously assigned 


a value. 


Literal value error -- the PICTURE clause field type 
does not match the VALUS clause literal tyne. 

Multiple decimals -~- a numeric literal in a VALUS 
Clause contains more than one decimal point. 

Multiple siens — а signed numeric literal in a VAGUE 
clause contains more than one sign. 

No file assigned — there was no SELECT clause for 


ее, 





NI 


NN 


NP 


NV 


ОЕ 


РС 


Er 


81 


R2 


RS 


SG 


Not implemented -- a production was used that is not 
implemented. 

пој тета -- ап invalid character was found іп а 
numeric strine. 

NOA UE Noa == no production exists for the cuurrent 
parser configuration; error recovery will automatically 
ОСС 

Numeric value -- a numeric value was assigned to a 
HNoncnumerbic item- 

Open error -- attempt to open a file that was not de- 
Glaneayeor attempted to open a file for I-O that was 
not a RELATIVE file. 

Picture clause — an invalid character or set of 
enaractvensserists.in the victure clause. 

Paragraph first —— а section header was produced after 
a paragraph header, which is not in a section. 

zedefire nesting == a redefinition was „made for ал 
ШО е cas part Of a redefined item. 

ЕТЕП == the length. of the redefinition item 
was greater than the item that 1t redefined. This error 
message may be printed out one identifier past the 
Pode mi denti ier record in- which ít occurred. 
Redefines misplaced -- a redefines was attempted in the 
МИ ООО ОГ the source program. 

Scanner error == the scanner was unable to read an 
wat нег апе to an invalid character. 


Sign error -- either a sign was expected and not 
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SL 


Ul 


CL 


МЕ 


wi 


“2 


found, or a sien was present when not valid. 
Significance loss -- the number assigned as a value is 
larger than the field defined. 

ШЕВЕРЕгтот == пе type of a subscript index is not 
integer numeric. 

Undeclared identifier -- the identifier was not 
declared in WORKING STORAGE area of the source program. 
Value error -- a value statement was assigned to an 
utem in the file section.: 

aone nevel orror —— program attempted to write a 


Deor Oter than an @1 level record to an output 


file. 
NN ERRATA FATAL ERRORS 
Close error -- the system was unable to close an outout 
tire. 
Make error -- the system was unable to make an input 


fle ona the disk. 

MO er an input file could not be opened, 

Write non-sequential -- attempted to WRITE to a file 
opened for INPUT or a file opened for I-O when ACCESS 
was SEQUENTIAL. 

Wrong key -- attempted to change the key value to a 
lower value than the number of the last record writ- 


ten. 
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WS 


#5 


W6 


W7 


GD 


IC 


write input -~ attempted to WRITE to a file opened 
GOT INPUT. 

Write non-empty -— attempted to WRITE to a non-empty 
Merc On Ce. 

Read output —— attempted to BEAD a file opened for 
OUTPUT. 

Rewrite error -- attempted to REWRITE to a file 


not opened fo І-0. 
по е ето == attempted to REWRITE a record before 
reading the file; or multivle REWRITE attempts with- 


out doing a READ between each. 


INTERPRETER WARNING MESSAGES 


с; 


Епа mark -- a record that was read did not have a 
carriage return or a line feed in the expected location. 
Go to derending -- the value of the depending indicetor 
was greater than the number of available branch 

ea are ssc or. 

Invalid character -- an invalid cnaracter was loaded 
Pato an output field during an edited move. For example, 


a numeric character into aa alphabetic-only 


field. 
Sign Invalid -- the sign is not a + ora -. 
Write Error —— attempted to write to an output file. 
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APPENDIX 93 


LIST OF MICRO-COBOL RESERVED WORDS 


The following is а list of reserved words for 
MICRO-COBOL. The reserved words are the same as those 
specified for the HYPO-COBOL language, except where noted 


with an asterisk (*). 


ACCEPT ENVIRONMENT MULTIPLY RUN 

ACCESS “OF * NEXT S AM 

ADD ECUAL NOT SECTION 
ADVANCING ERROR NUMERIC ЭСИС 
AFTER EXIT OBJECT=-COMPUTER SELECT 
ALPHABETIC £D OCCURS SENTENCE 
ASSIGN FILE OF SEPARATE 
AUTHOR FILE-CONTROL OMITTED SEQUENTIAL 
BEFORE FILLER ОРЕМ SIGN 

BLOCK FROM ORGANIZATION 512% 

BY GO ОШТРОТ SOURCE -LONAU NER 
CALL GREATER PAGE SPACE 
CLOSE 150 PERFORM STANDARD 
COBOL IFO CONTROL PIC STOP 

COMP IDENTIFICATION PROCSLURE SUBTRACT 
CONFIGURATION IF PROGRAM SYNC 

DATA ENEUT PROGRAM-15 TERU 
DATE-WRITTEN INPUT-OUTPUT QUOTE TUNES 
DEBUGGING INVALID RANDOM TO 

DELETE INTO READ TRAILING 
DEPENDING LABEL RECORD UNTIL 
DISPLAY LEADING RECORDS USAGE 
DIVIDE LEFT REDEFINES US ING 
DIVISION LESS RELATIVE VALUE 

ELSE LINKAGE REWRITE WORK ING-STORAGS 
END MODE RIGHT WRITE 
ENTER MOVE ROUNDED ZERO 
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APPENDIX C 


БІ ПІСОПО-СОЕОШР compiler and interpreter source files 
currently exist in the high level language PLM8f€ and are 
edited and compiled under the ISIS operating system on а 
INTEL Corporation MDS system. This is a description of the 
procedures required to compile and establish the programs to 
Compile and interpret a MICRO-COBOL program. The MICRO-COBOL 
compiler and interpreter run on any 8080 ог 27-80 based 
microcomputer that operates under CP/M. The execution of the 
moerowing four files will cause a MICRO-CCB8OL program to be 


Compiled and executed: 


i COOL. COM 
e РАТА. СОМ 
о. RENSG.COM 


4. CINTERP.COM 


These four files are created from the following six 


PLM8@ source programs. 


МИ РАНО РЕМ 

ЕЕ PART2. PLM 

Se BUILD. PLY 
IREADER.PLM 


SS DNTRSDR.PEM 
2 ОКР РЕМ 


The procedures used to create the four object files (COM 


files) involve compiling, linking, and locating each of the 


Tog 





ЕП 5опгсе files under ISIS. The SID program is then used 
Шел СР/М to construct the executable files. Zach of the 
following steps describe the action(s) to be taken and, 
where appropriate, the command string to be entered into the 
computer. 

1. An ISIS system disk containing the PLM89@ compiler is 
placed into drive A and a non-system disk containing the 
source orograns is placed into drive B. It should be noted 
that drive à and B are the CP/M reference names for the 
Serves while FI and Fe are the ISIS reference names used for 
the associated disk drives. 

2. Compile the PLM source program under ISIS using the 


the following command: 


PLMEY :F1l:<Pilename>.PLM DEBUG XREF 


DEBUG saves the symbol table and line files Рог later 
use during debugging sessions. XRz* causes a cross-reference 
esting, of all identifiers in the source program, to be 
emeated. The cross-reference 5710 includes each 
identifier and the associated line number where the 
identifer was declared and the line number of each occurence 
of the identifier in the source program [9]. 


Se оте се PLM6OS object file. 


ME xcrrlename».O0BJ. TRINT.OBJ. PLMSC.LIBS, TO 


supecfilename-^.MOD 


See reference 19 for an explanation of PLMEO.LIS. The 
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NT OBJ brogram interfaces tne МОМ апа моме functions of 
CP/M to the source program, allowing for the use of absolute 
addresses in referencing these functions. 


4. Locate the object file. 
LOCATE :Fl:<filename>.MOD CODE(org address) 


The org address’ is the address where the program will 
begin to be loaded into memory. The following are ‘org 


addresses for the associated program: 


Panwa. MOD 100H 
Ранта Мор 1098 
ПУН АМО 120H 
INTRDR.MCD GOH 
BULLD MOD 1008 


IREADER.MOD 10028 


The org addresses above represent the ones used with a 62% 
byte CP/M system. The only address that would seed to be 
Changed if a different size system was used would be the one 
for TRADS. MOD. See appendix Y Рог specifics on the address 
to use for IREADER. 

4a. The two files INTRDR and [READER just created by the 
LOCATE command must be converted to HBX FILES”. By using 
bee [515 command  OBJHEX «filename?» the file will be 
converted to the “HEX file” <filename>.HEX. 

“Шеп асе the ISIS system disk in drive A with a CP/M 


system disk and reboot the system. 
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Стае ег Рие located [SIS file from the ISIS disk on 


drive B to the CP/M disx on drive A. 
FROMISIS <filename> 


Ga. When transfering the HEX files to the CP/M disk 


use the following: 
FROMISIS <filename> .H3X 
Сое "оде ISIS file to a CP/M executable form. 
OBJCPM <filename> 


7a. The HEX files are not coverted to a CP/M format, 
but are left in the HEX format. 

At this point the object file is in machine readable 
morm and will run under CP/M when called properly. PAkT2Z.COM 
and CINTERP.COM are called by PART1.COM (COBOL.COM) and 
AECL COM, respectively and need no further work. P&RT1.COM 
and EXZEC.COM need to be constructed from tne remainiag four 
нео. 


АТОМ is стБабері by enterine the followirz commands: 


A SODA. COM 
p LRUNDES. SEX 
5.  R6200 

AZAOA 


5. УҮМР 00000 
СЕИ Солго Тс 


AS aer oe COBOL.COM 
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See reference 6 for an explanation of the 1 , 2 , and 
"A commands used above and ref 4 for an explanation of the 
“SAVE” command. Steps four and five above are used to patch 
the JUMP to IREADER referred to in the PART1.PLM program 
са tne РАН11 СОМ program. 


EXEC.COM us created by entering the following commands: 


ПИР BUILD. COM 


Bee INL ALA SEX 

cx bo? 

4. — ALCBS 

О ЈЕО 

ПА 51001 

т и, 

= eCONTROL-C 

ОО ЕДА 51 EXEC .COM 


Statements 4, 5, 6, and 7 above are used to patch the 
ШЕР to BOs referred to in the INTRDR.PEM program into the 
INTRDR.HEX program. 

NPS  MICEO-COBOL programs may now be executed in the 
following manner. The source program is named, 
<filename>.CHL. The command COBOL <filename> , causes the 
Moro -COSOpesoOurce = program to be read into memory and 
compiled. During the compilation, the intermediate code 
file, <filename>.CIN, is written out to the disk as the code 
is generated. The command ‘EXEC <filename>’, causes the 


file, <filename>.CIN, to be executed. 


141 








APPENDIX D 


PART ONE AND PART TWO INTERNAL DATA STRUCTURES 


AND SIGNIFICANT VARIABLES 


Within PART ONE and PART TWO, many significant data 
Structures are used by the procedures which constitute the 
scanner and parser. Descriptions are given below for those 
structures regarded as important and necessary for future 


compiler development. 
Ши пп ресгтасјлле structures 


ADDSEND -- this variable is used to hold the end of 
file filler for the end of the source program. 

BUFFER(11) -- byte array used to hold the filename 
and filetype if declared, of an input or outout file in the 
Peeotcl CLAUSE of the FILE SECTION of a MICRO-COSOL source 
program. 

BUFFERSEND -- address variable which marks the last 
ео the compiler input buffer which is a 128 byte buffer 
used for reading the source program. 

INSADDR —— address variable, default file control 
(лоше used initially to hold the <filename.CBL> of the 
source program to be compiled. 

INSBUFF -- literal value, marks the first byte of 
the compiler input buffer. 

INPUTSFCP -- byte value, based at INSADDR(33), the 


base address of the default file control block of the source 
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ГОосгат. 
OUTPUTSRUFF(128) -—- byte array, used as a 128 byte 

output puffer for loading the generated output (pseudo 

instructions) when writing to the intermediate code file. 

OUTPUTSCHAR -- byte value, based at the OUTPUTSPT3R; 
Meer (о identify the particular byte of the output buffer 
(OUTPUTSBUFF) to whi ch the next intermediate code 
imsbruction is to be written. 

OUTPUTSEND -- address variable, pointer to the end 
of the output buffer (OUTPUTSBUFF). 

OUTPUTSFCB(33) -- byte array, the FCB for the 
intermediate code file <filename.CIN> established in PART 
ONE of the compiler and pasted to PART TWO of the compiler 
by IREADER module. 

OUTPUTSPTR -- address value, used as an index into 
the output buffer (OUTPUTSEUFF). 

POINTER -- address value, the address of the byte 


holding the next input character of the source program. 
Zee veoouee ine structures 


DEBUGGING -- logical byte value, toggle used in 
conjunction with “: in a MICRO-COBOL source program text; 
allows mene one Compilation or -non-comp3letion of “xe 
deugging Staterents following the 

LISTSINPUT -- logical byte value, toggle used to 
Eua Or not display a source program to the CRT during 


compilation. 





PARMLIST(9) -— byte array used to hold the toggles 
set by the compiler developer or user upon execution of the 
command: COBOL <filename.CRL> STOGGLES. 

PRINTSPROD -- lozical byte value, toggle used to 
punt, in chronological order, at the CRT the production 
numbers of the compiler grammar rules used during 3 
compilation of the source program. 

SEOSNUM -- logical byte value, toggle used to 
indicate the presence of sequence numbers in the first six 


positions of each line of a source program being compiled. 
5. Memory Structures 


ТОКТО ЕН == literal value, used to test for the 
occurrence of an end of file character ( 14H” in CP/M), when 
reading the source program. 

FREESSTORAGE -- first free address following PART 
ONE of the compiler; utilized as the base of the symbol 
table. This is the same value as HASHSTABSADDR in PART ТҰС 
тле compiler. 

Јат о POS ==. address value, the in1tial location 
of the IREADER module before it is copied to high memory at 
location MAXSMEMORY. 

MAXSMEMORY -- address value, the location in high 
memory where the IREADER module is to be moved. 

NEXTSAVAILABLE -- address value, tre pseudo machine 
memory address for the next machine instruction. 


PAZT1$LEN -- the number of bytes of information 








saved in high memory after execution Of PART ONE and used to 
initialize PART TWO module variables of the compiler. 

РА5515ТОР —— this address is used in conjunction 
with PASS1SLEN for locating the fourty-eisht bytes of 
information saved in PART ONE for use in PART TWO of the 
compiler. 

PDRSLENGTH -- literal value representing the 255 
bytes of the IREADER module to be moved from INITIALSPOS to 
MAXSMEMORY. 


4. 5саппег Structures: 


ACCUM(S1) -- an array of 51 bytes; the first byte 
contains a count of the total number of characters currently 
in the accumulator. This structure holds tokens as they are 
Scanned, and will hold either a reserved word, a user 
defined identifier, or a literal. 

COLLISION -- address varible, contained in first two 
bytes of an identifier’s symbol table entry and indicates 
whether there is another identifier which hashes to the same 
hash table address. This address points to that identifier's 
address in the symbol table. 

DISPLAY(74) — an array of 74 bytes; the first byte 
contains a count of the total number of characters (1-73) 
eurrentiy іп the display buffer. Every line within a source 
аморат 15 loaded into this structure for Subsequent 
Ке to the CRT terminal during compilation. 


EDITSFLAG -- logical flag which denotes the fact 





that a “5” symbol has been loaded into the DISPLAY array 
during compilation. When set the characters within DISPLAY 
will ve printed one at a time, until the entire line is 
Printed. 

HASHSTABLESADDR -- the base of the symbol table 
generated in PART ONE, used as the base of the hashtable. 

HASHSTABSADDR -- this was the address of the bottom 
of the symbol table generated in PART ONE of the compiler, 
and saved for Part two. 

MMBUTPSSTREE- literal value (32), returned to the 
LALR(1) parser anytime the token contained in the ACCUM is 
not a reserved word or literal. 

MITRAL == "literal value (15), returned to the 
LALR(1) parser anytime the first character encountered by 
me scanner is a quote (°), prior to loading the ACCUM. 

MAXSLEN -- length of the longest reserved word 


allowed by MICRO-COBOL. 
а, Батсар Structures: 


BUFFER (31) -- byte array used to store edited 
PICTURE CLAUSE characters for subsequent intermediated code 
generation. 

COMPILING -= logical byte value which indicates that 
compiling is taking place or not in PART ONS or PART TWO; 
set to FALSE whenever the statestack of the LALR(1) parser 
is reduced to a recognizable finished state. 


CURSSYM -- address variable that holds the address 
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of the current symbol being accessed in the symbol table. 

DUPSIDENSARRAY(24) -- address array that holds the 
symbol address for all files declared in the INPUT-OUTPUT 
SECTION of a source program. When the FILE SECTION entry for 
the file is encountered the array is searched to determine 
if the file was declared and to insure that a FILE SECTION 
entry had not been previously made. 

FILESDESCSFLAG -- logical byte value; indicates 
whether the compiler is compiling the FILE DESCRIPTION 
mee Li ON of a source program or not. 

FILESSECSEND —logical byte value set whenever the 
varser has parsed passed the FILE SECTION of a source 
program. 

HOLDSLIT(51) — byte array, first byte contains a 
count of the total number of characters currently stored in 
Pye HOLDEIT buffer which is used to hold characters for a 
VALUE CLAUSE. 

І255ТАСЕ(14) -- address array which functions as a 
stack and 1s used to hold the addresses of identifiers at 
both the record and elementary levels. Whenever a record 
identifier has nested elementary field identifiers it is 
saved on the IDSSTACK. Also, anytime a record identifier ras 
succeeding record identifiers redefining it, it is saved on 
Mee wl@Ss ACK. In the case of multiple record descriptions in 
би "Те description of the FILE SECTICN, the record 
descriptions following tre Pot ОО a - о пио 


redefinitions. 
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IDSSTACXSPTR -- a byte index veriatle into the 
IDSSTACK array. 

MAXSIDSLEN -- a numeric value (12), maximum length 
of any user defined identifier. 

== byte index variable into the VALUE array. 

MEERES byte index variable into ‘the VALUE агтағ, 
one byte above MP index. 

NEXTSSYM -- this address indicates the next 
available free space for a symbol table entry. 

PENDINGSLITERAL == byte value (а. 1 ожени =), 
indicates the category of the target input to a VALUE 
CLAUSE. 

PENDINGSLITSID — byte value (8,1,2,3,4,5), which is 
saved to indicate the category of the most recently 
encountered target input to a VALUE CLAUSE. 

PRODUGIEON —— byte value, determined by the parser 
and indicates the next semantic action to be tazen by the 
compiler. 

REDEF -- logical byte value which allows the testing 
of an identifier’s storage value size azainst the storaze 
ШӘШШПЕе cize of a second identifier that redefines the first. 
set to TRUE when there are multiple record descriptions 
шп а ED BLOCK in the FILE SECTION, or when a record or 
elementary identifier declaration in the WORZING STORAGE 
SECTION contains a REDEFINSS CLAUSE. 

REDEFSFLAG -- logical byte value, used tə denote the 


scanning and parsing of the FILS SECTION of a source 
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puseram, helps in identifying duplicate identifiers within 
mats Section. 

REDEFSONE -- address variable that holds the symbol 
table address of the identifier being redefined by another 
identifier. 

EEDEFSTWO -- an address variable that contains the 
symbol table address of an identifier which redefines 
another identifier. 

Sea а byte Index for the STATSSTACK array and ihe 
RUE array; points to the top of the STATESTACK array. 

STATE => a byte value numeric quantity that 
indicates the current parser state. 

STATESTACK(30) -- a byte array which stacks the 
states (production sequences) the parser passes through 
while compiling a source program. 

TEUNCSFLAG -- logical byte value that indicates 
numeric truncation of an identifier/s VALUE CLAUSE input 
hasn't occurred, because the identifier’s associated PICTUFE 
CLAUSE nas not been scanned and parsed. 

VALUE(3@) -- an address array that holds addresses 
of identifiers, specific attributes of these identifiers and 
attributes of the current source program statement ог 
sentence being parsed. 

VARC(51) -- a byte array, the first byte holds tae 
ши of the total number of characters within it, used to 
hold all the ASCII characters of tokens scanned within the 


source program, excluding reserved words; for subsequent 
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analysis and processing. 

VALUESFLAG -- a logical byte that is set anytime an 
identifier has an associated VALUE CLAUSE; used primarily to 
recognize the occurrence of a PICTURE CLAUSE before the 
VALUE CLAUSE or when a record entry has a VALUE CLAUSE, but 
ПӘ! а55осіаФбей PICTURE CLAUSE except for those in its 
elementary field identifiers. 

VALUESLEVEL -- a byte value which saves the level 
number of a record identifier which doesn't have ап 


associated PICTURE CLAUSE. 
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ROBENDIX E 


The NPS MICRO-COBOL compiler/interpreter is designed to 
operate on any 8080 or 280 based microcomputer operatinae 
under CP/M with at least 2@K bytes of memory. The PLM82 
source files have been written in such a way, that certain 
variables must be altered in the source code to take 
advantage of the machine that the programs are going to be 
operating on. This appendix covers those programs and the 
variables that must be altered. 

ШӘЗБАНТІ РІМ 

This program has two variables that are nemory size 
dependent, MAXSMEMORY and MAXSINTSMEMORY. The variable 
MAXSMEMORY is set to 10@H bytes below the base of tne 3205 
and is used for the beginning address of the [READER 
routine. The variable MAXSINTSMEMORY is set to the base 
meoress of the RDOS and is used as the upper limit for the 
intermediate code file. 

Bee BHT 2 Oe LM 

This program also has two variables that are memory size 


dependent, MAXSMEMORY aide Ра о РА Ал ој. | љета 


23 


MAXSMEMORY is set to the base address of the BDOS while 
РА5515ТОР 15 set to 12€0H bytes below the base of the 3DCS. 
5. IREADER .PLM 
Altrougshħh, this program does not have any memory size 
dependent variables the program must be modified to execute 


properly. When using the LOCATE command, under ISIS, this 


к 


routine must be located 1900H bytes below the 3205 о tne 


Le 






system. This address would correspond to the values of 
MAXSMEMORY in PART2.PLM and MAXSINTSMEMORY ina PART1.PLM. 

Ar INTERP.PLM, INTRDR.PLM, and BUILD. PLM 

These three programs have no variables that need to te 
altered. 

5. GENERAL INFORMATION 

The eürTenL version of the NPS MICRO-COBOL 
compiler/interrreter is designed for continued development 
and certain variables are not set to make optimal use of 
memory. The variatle NEXTSAVAILABLE, in PARTL.PLM, is set to 
ОООО алд CODESSTART, in INTERP.PLM, is set to 39908. 
Normally, CODESSTART would be set to the address immediately 
monlowlnes the last address in CINTERP.COM and NEXTSAVAILAELE 
would be set two bytes above that address. These address are 
enr rently set approximately 95968 bytes above where they 
ПАОЛА Бе located, to allow for testing and expansion of the 
interpreter. As soon as implementation 15 completed these 


two addresses can be reset to appropriate values. 





APPENDIX F 
MICRO-COBOL Parse Table Generation 


The parse tables for NPS Micro-Cobol were generated on 
the IBM 360 using the LALR(1) parse table generater 
described in reference 17. There are basically two steps 
involved in generating the tables. First, a deck of cards 
containing the grammar is entered into the computer using 
ШЕ following JCL: 

//GO EXEC PGM= LALR,REGION=222K 

//STEPLIB DD DSN=F8963.LALR,UNIT=2314, 

VOL=SER=LINDA,DISP=SHR 

//SYSPRINT DD SYSOUT=A,DCB=(RECFM=FR, 

ІКЕСІ-1225,ВІК517%-55259), 

MASpNPESEUOYL.(1,1)) 

//NONTERM DD SPACE=(CYL,(1,1)),UNIT=SYSDA 

Poe eens DO, SPACBE=(CYL,(1,1)),UNPT=SYSDA 

ЖІРТІНГЕЗ DD SYSOUT=B, 

DCB=(PECFM=FB,LRECL=82, BLXSIZ5=372) 

СКОТЧ рр = 

БИРЕП rrom this run is a listing and a card deck 
containirg the tables ir XPL compatable format. This deck is 
then translated into PLM compatible format using the 
АШ ом пе ЈСЕ and an XPL program which is available in the 
card deck library in the Computer Science Department at the 
Naval Postgraduate School. 


Vi EXEC RCON 
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V7GOMP.SYSIN DD * 
ПА о По РОН DD SYSOUT=2, 
DCB= (RECFM=FB,LRECL=89 ,BLKSIZE=892) 
//GO.SYSIN DD * 
The tables are then transferred to a disxette end edited 
о the PLM8 source program using the ISIS COPY and “EDIT 


features on the INTEL MDS System. 








APPENDIX G 
LIST OF INOPERATIVE CONSTRUCTS 


The following is a list of MICRO-COPOL elements that 
either have not been implemented or have been implemented 
Miciorrectly. 

LINKAGE SECTION 

USAGE COMP 

(LEADING) 
SIGN SEPARATE 
{TRAILING} 
{LEFT} 
{RIGHT} 

ADD 

DEDE 

DELETE 

EXIT 

MOVE 

vont PLY 

SUSTRACT 

Tke fol lowing PT OSC COBROL elements are part or 
MICRO-CO3CL only to the extent tnat they are derined in the 
grammar. No code has been written to support them. 

USING 

CALL 


С 


NTER 


Los 








{BEFORE} {INT?GER } 
WRITE record-nanme ADVANCING 
{AFTER} {PASE} 
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(ОНИ РАДНЕ ТО РРМС5 


PART1: 
DO; 
/% NORMALLY ORG ED AT 100H */ 
/* COBOL COMPILER - PART 1 х / 
/* GLOBAL DECLARATIONS AND LITSRALS m 


DECLARE LIT LITERALLY 'LITERALLY^; 


DECLARE 
PARMS CIT “бін”, 
PARMLIST(9) BYTE IBERIA. г 
EOFFILLER LiT "ТАН, 
/* END OF RECORD FILLER */ 
MAXSMEMORY RT горео“, 
/* TOP OF USEABLE MEMCRY */ 
INITIALSPOS LIT "329908 ’, 
RDRS LENGTH LIT E2557 
PASS1SLEN LIT 48“, 
CR ET Aou. 
LF LIT 10°, 
QUOTE LIT “27H”, 
POUND LiT “23H”, 
TRUE LIT M 
FALSE [AT a 
FILESDESCS FLAG BYTE INITIAL(FALSS), 
REDE FSFLAG BYTE INITIAL(FALSZ), 
DUPSIDENSARRAY(24) ADDRESS 
INITIAL(0G,0,9,0,0,90,0,9,0,90,0,0,2,0,0,0,0,0,0,0,2,9,90,0), 
FOREVER en “WHILE TRUE ; 
DECLARE MAXRNO LIT ^104^,/* MAX READ COUNT */ 
MAXLNO LIT °129°,/* MAX LOOK COUNT */ 
MAXPNO LIT “145°,/* MAX PUSH COUNT */ 
MAXSNO LIT САН ИН STATE COUNT = 
STARTS LIT SS DARDOS TA TENES 


DECLARE R3AD1 (*) BYTE 

Диос 48 56/52 ,8,25,59,2,16,17,22,29,53,58,11,52,32,39 
ДЕБ /24,44,9,19,52,57,6,55,5,14,15,18,20,52,28,49,32,1,42 
БС 217:1,1,1,1,10,1,39,1,1,1,58,40,49,58,59,1 
ШІ. 58,25,24,25,52,41 ааб gly COs toes Ly eI 
22 1.502,1,02,47,57,4,26,32,54,40,1,1 

ИЕ 12715 21 22.27,1,62,1,25,24,55,30,51); 

LECCARE LOOK1(%) BYTE 

AV. 385 0,292,2,9,19,0,42,0,42,0,1,9,52,0,41,08,35,0,1,9,47 
NIE 1 O, 00, 20,60,2,1,0,32,848,1,0,1,0,11,0,60,€,7,4 
0682,0 .52,0); 

DECLARE APPLY1(*) BYTE 

DNI. 27.0590,0,0,9,10,12,14,19,0,0,0,0,0,0,101,0,0,1090,0 
209595905797, 0,27,0,0,0,69,0,91,92,2,0,21,92,0,0,2, 0,15 
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,17,0,102 ,195,104,0,0,0,0,0,95,0,0,54,0,0,25,30,38,59,0 
221,40,52,56,87,935,94,0); 

DECLARE READ2(*) BYTE 

ПИ 65.57.64 ,154 26,37 67,21,30 ,351,335,39,61,66,27 ,2354 

E a 108: 109,225,224,2535,45,216,217,22,230,229,252 
ДЕСІ Е 28 175  ,172.159,9,226,47,;196,195,7,8,11,13,15,2,5,1925 
ША" І5Е 4,50,20,12,18 646,171 ,170,44 ,49,19,10,46,55.56 
,63,60,53,42,146,16, 25, 58,126,155 ;145 155 , 1985.55 04509. $55 
,152,155,157,155,56,195,25,208,254,62,52,206 
,1890,2354,24,28,107,52,54,58,17,68,164,55,56,65,40,59); 
DECLARE LOOK2(*) BYTE 

ПИ 5 152. 6.151,29,29,152,41,1535,54,134,135,69,71,136 
,72,137,735,1358,139,80,84,140,86,198,88,141,89,142184,184 
,184,91,189 ‚92,93,197,211,95,143,96,97,176,99,144,145,121 
,192,2900,1035,202,104,188); 

DECLARE APPLY2(*) BYTE 
ШКТА(7,0,77,111,112,147,79,114,81,82,85,78,76,117,75,156 
,126,165,162,1270,166,165,167,118,168,160,124,179,178,94 

#121 74,125 12 119. 127 187,126,98,192 ,192 ,191,184 115 
Ма 129,127,205,205 ,205,204,115,125,9€,122,214,215,221 
,219,218,222,199,85, 229 ,116,87 119,743,174, 299,207 ,182 
,182,181); 

DECLARE INDEX1(*) 2YTE 

Purge о 64. 5 .5.2,8,4,4,24,4,24,4,15,14,24,199,4,15,16 

Ми 24 17,18,15,16,29,22,24,25,26,28,29,54,36,57,24,24,16 
‚38,59,40 БЕР АДА А6. 46.47 28,49,16 ,50,358,51 16.52.55 54 
95,56,57,58,60,61 ,62,65,64,8,685,68,69,70,71,72,73,74,75,77 
‚”9,81,83,85,87,28,29,90,92 "93.54 ,8,8,16,95,97,97. 15 193 
EL: 05. 109,24,24,24,1,5,5,8,18,12,14 ,16,18,20,22,24,26,28 
‚30,34,35,38,49,42,44,46,48,59,52,185,149,225 

1927. 227,199,151 

Иле 150217 161,175,212,201,177,1,2,5,5,4,4,5,5 ,6,6,12 
Remmi 15 ІЕ,16,17,19,19,22,22,20,22,22,25,235,24,2%,25 
BEN 55 27029 29.351,52. 82.35,593,55,358,38,55,55,39,509,59 
‚59,59,42 Weegee 24-44 45 45,48,52,52,52,53,54,54 55 55 


,56,56,56,56,56,56 ,56,56,58,58,58,59,59,61,61,61,61,61 
52 67); 
DECLARE INDEX2(*) RBYTS 
ШОР 1.1:1,5,1,1.1,;1,1,1,1,1,1,1,1,1,1,1,.1,. 1,1 
МИРА = (оте 1.50,2,1,1,1 О КИТ ;1 о а AL 
p.l, Dl BEEN. 1.1.1,15,5,5,;1,1,1,1,1,1,1,.2.2,.2:2 02.2 
8E 10,1 POR 5 IE. 4c. pling Lage ес PI EC 
EEUU ~ = ,2,2,2,2,2,2 ,2,2,9,6,29,41,54,69,71,72 
75 82,.24,88,85,96,99,181,5,9,5,0,3,9,3,0 30,1478, 1:055. 40 
ПИ поло 1. 2.0.0,0,1,9,2,0,5,1,2,0,1,5,53,0,0,1 ,+,0,9 
Ио | = 2 2 0.2,5,0,3,0,0,1,45,0,0,1,09,0,0,0,1,1,1,1,2,2,1 
,1,;,1,0,0,0,0,0,0,0,0,0,0,90,0); /* END CF TABLES */ 
DECLARE 

/* JOINT DECLARATIONS 


THESE ITEMS ARE DECLARED TOGETHER IN THIS SECTION 
IN CRDER TO FACILITATE THEIR BEING SAVED FOR 
THE SWGOND PART OF THE COMPILER. */ 


OUTPUTSFCB (33) BITE 








INITIAL(2, | 20m. 0,0,0,0)4 


DEBUGGING BYTE INITIAL (FALSE), 
PRINTSPROD BYTE INITIAL( FALSE), 

PRINTSTOKEN BYTE INITTAL(FACSE), 

LISTSINPUT BYTE INICTAL (TRUS), 

SEOSNUM BYTE INITIAL (FALSE), 
NEXTSSYM ADDRESS, 

POINTER ADDRESS INITIAL (1225), 


NEXTSAVAILABLE ADDRESS INITIAL (3222H), 
MAXSINTSMEM ADDRESS INITIAL (9D1900H), 
FREESSTORAGE ADDRESS, 

FILESSECSEND ВҮТЕ INITIAL (FALSE), 


/* I O BUFFERS AND GLOBALS */ 
INSADDR ADDRESS INITIAL (SCH), 
INPUTSFCB BASED INADDR (33) BYTE, 
OUTPUTSPTR ADDRESS, 

OUTPUTSBUFF (128) BYTE, 

OUTPUTSEND ADDRESS, 

OUTPUTSCEAR BASED OUTPUTSPTR BYTE; 


MON1: PROCEDURE (F,A) EXTERNAL; 


DECLARS A ADDRESS, F BYTE, 
END MONI; 


MON2: PROCEDURE (F,A) BYTE EXTERNAL; 
DECLARE * BYTE, A ADDRESS; 
END MON2; 


300T: PROCEDURE EXTERNAL; 
DECLARE A ADDRESS; 
END BOOT; 


PRINTCHAR: PROCEDURE (CHAR); 
DECLARE CHAR BYTE; 
CALL MON1 (2,CHAR); 

END PRINTCEAR; 


CRLF: PROCEDURE; 
CALL PRINTCHAR(CR); 
CALL PRINTCHAR(LF); 
BND CRLF; 


PRINT: PROCEDURE (A); 
DECLARE A ADDRESS; 
CALL MON1 (9,A); 

END PRINT; 


PRINTSERROR: PROCEDURE (CODE); 
/* THIS PROCEDURE IS USED TO PRINT COMPILER ERRORS TO 
CONSOL */ 
DECLARE CODE ADDRESS, 
I BITE” 
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CODE1(6) ADDRESS; 
IF CODE = FALSE THEN 


DO; 
о TO 5; 
CODEI(I) = 19; 
END; 
I = Ø; 
END; 
ELSE 
IF CODE = TRUE THEN 
DO; 
Bae 
ро WHILE((I <> 6) AND ( CODE1(I) <> 8)); 
GALL CRLF; 
CALL PRINTCEAR(HIGR(CODE1(I))); 
CALL PRINTCHRAR(LOW (CODE1(I))); 
(OM TE 25 
lucc * 1; 
END; 
LE 
END; 
ELSE 


ШЕН ПЕШЕ - NP ) OR (CODE = SL) OR (CODE = NV) "TEEN 
DO; 

(ПОП САДУ; 

CALE PRINTCHAR( HIGH(CODS)); 

CALL PRINTCHAR(LOW(CODE)); 
END; 
ELSE 
DO; 

IF I <> 6 THEN 

DO; 

CODE1(I) = CODE; 
) 


END; 
р 


END; 
END PRINTSERROR; 


FATALSERROR: PROCEDURE( REASON); 


DECLARE REASON ADDRESS; 
CALL PRINTSERROR( REASON )} 
CALL PRINTSERROR(TRUE); 
CALL ТІМЕ(10); 

CALL BOOT; 


END FATALSERROR; 


OPEN: PROCEDURE; 


IF MON2 (15,INSADDR)=255 THEN CALL FATALSERROR( 02 ); 


END OPEN; 


MORESINPUT: PROCEDURE BYTE; 


/* READS THE INPUT FILE AND RETURNS TRUE IF A RECORD 
WAS READ. FALSE IMPLIES END OF FILE */ 
DECLARE DCNT BYTE; 
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IF (DCNT:=MON2(29,.INPUTSFCR))>1 
THEN CALL FATALSERROR(/BR/); 
RETURN NOT (DENT); 
END MORESINPUT; 


MAKE: PROCEDURE; 
/* DELETES ANY EXISTING COPY OF THE OUTPUT FILE 
AND CREATES A NEW COPY*/ 
CALL MON1(19,.OUTPUTSFCB); 
IF MON2(22,.OUTPUTSFCB)=255 THEN CALL FATALSERROR( MA’); 
END MAKE} 


WPITESOUTPUT: PROCEDURE; 
/* WRITES OUT A BUFFER */ 
CALL MON1(26,.OUTPUTSBUFF) ; /* SET DMA */ 
ІР MON2(21,.0UTPUTSFCB)<>@ THEN CALL FATALSERROR( WR’); 
CALL MON1 (26,808); /* RESET DMA */ 
END WRITESOUTPUT; 


MOVS: PROCEDURE(SOURCE, DESTINATION, COUNT); 
/* MOVES FOR THE NUMBER OF BYTES SPECIFIED BY COUNT */ 
DECLARE (SCURCE,DESTINATION) ADDRESS, 
(SSBYTE BASED SOURCE, DSBYTE BASED DESTINATION, COUNT) 
BYTE; 
DO WHILE (COUNT:=COUNT - 1) <> 255; 
DSBYTE=SSBYTE; 
SOURCE=SOURCE +1; 
DESTINATION = DESTINATION + 1; 
END; 
END MOVE; 


FILL: PROCEDURE(ADDR,CHAR,COUNT); 
/* MOVES CHAR INTO ADDR FOR COUNT BYTES */ 
DECLARE ADDR ADDRESS, 
(CEAR,COUNT,TEST BASED ADDR) BYTE; 
DO WHILE (COUNT:=COUNT -1)<>255; 
DEST=CHAR; 
ADDR=ADDR + 1; 
END; 
END FILL; 


eee SCANNER LITS * * + * «*/ 
DECLARE 


LITERAL LiT To? 
INPUTSSTR LT 32, 
SRIOD LIT pee 
INVALID ЕТ б; 


ПА ~ SCANNED TABLES ж = * > ж/ 

DECLARE TOKENSTABLE (*) BYTE DATA 
/* CONTAINS THE TOKEN NUMBER ONE LESS THAN THE 
FIRST RESERVED WORD FOR EACH LENGTH OF WORD */ 
ПА РАБ 15 22 30.380 44€47,49,51,55,56,57), 


le) 








ПЕРЕ С) Вию БАТАК Зр, OF’, TO’, ’PIC’, COMP”, РАТА“, FILE’ 
ПОПИТ ИСТЕ АМЕ“, SIGN’, SYNC’, ZERO’, BLOCZ’, “LABEL” 
meouemr , PIGHT . SPACE’, USAGE’, VALUE’, ° ACCESS’, ASSIGN’ 
Итон , FILLER , OCCURS’, RÁNDOM”, “RECORD”, “SELECT” 
MeploPLAY , LEADING’, LINKAGE’ , OMITTED’, “RECORDS “ 
SECTION, DIVISION”, RELATIVE”, SECURITY /, “SEPARATE 

, STANDARD’, ‘TRAILING’, "DERUGGING”, “PROCEDURE”, “REDEFINES” 

, PROGRAM-ID’, SEQUENTIAL’, ENVIRONMENT’, I-O-CONTROL’ 

, DATE-WRITTEN”, FILE-CONTROL’, INPUT-OUTPUT’, ORGANIZATION’ 
, CONFIGURATION’, ‘IDENTIFICATION’, ОВЈЕСТ-СОМРЏТЕН“ 

, SOURCE-COMPUTER’, “WORKING-STORAGE’), 


OFFSET (16) ADDRESS 
/* NUMBER OF BYTES TO INDEX INTO THE TABLE 
FOR EACH LENGTH */ 
INITIAL (0,0,8,6,9,45,80,128,179, 218,245,265, 
287,335,348,362), 


WORDSCOUNT (*) BYTE DATA 
/* NUMBER OF WORDS OF EACH SIZE */ 
ЖЕ |! 9 7-.8235.5,5,2,2,4,1,1,3), 


MAXSLEN LIT CN 

ADDSEND(*) BYTE DATA (“PROCEDURE ^), 
LOOKED BYTE A 

HOLD BYTE, 

BUFFERS END ADDRESS INITIAL (1008), 
NEXT BASED POINTER BYTE, 
INBUFF LIT (Sone. 

CHAR BYTE, | 

ACCUMSLENG LET E 
ACCUMSLENSP$1 LIT Se 


/* = TO ACCUMSLENG PLUS 1 */ 
ACCUM (ACCUMSLENSPS1) BYTE, 


DISPLAY(74) BYTE INITIAL (0), 
TOKEN ВҮТЕ, /*RETURNED FROM SCANNER */ 
EDITSFLAG BYTE INITIAL(FALSE); 


ae ox PROCEDURES USED BY TEE SCANNER х = ж */ 


NEXTSCHAR: PROCEDURE BYTE; 
IF LOOXED THEN 


DO; 
LOOKED- PALSE; 
RETURN (CHAR:=HOLD); 
END; 
IF (POINTER: =POINTER + 1) >= BUFFERSEND THEN 
DO; 
IF NOT MORESINPUT THEN 
BOs 
BUFFERSEND=.MEMORY; 
POINTER=.ADDS END; 
END; 


ЕСЕ 








ELSE POINTER=INBUFF; 

END; 
IF NEXT = FOFFILLER THEN 
DO; 

BUFFERSEND = .MEMORY; 

POINTER = .ADDSEND; 
END; 
RETURN (CHAR:=NEXT); 

END NEXTSCHAR; 


GETSCEAR: PROCEDURE; 
/* THIS PROCEDURE IS CALLED WHEN A NEW CHAR IS 


NEFDED WITHOUT THE DIRECT RETURN OF THE CHARACTER*/ 


CHAR=NEXTSCHAR; 
END GETSCEAR; 


DISPLAYSLINE: PROCEDURE; 
DECLARE I BYTE; 
IF NOT LISTSINPUT THEN RETURN; 
IF NOT EDITSFLAG THEN 
DO; 
DISPLAY(DISPLAY(@) + 1) = 5°; 
CALL PRINT(.DISPLAY(1)); 
END; 
БОЛО ТО = 1 TO DISPLAY(@); 
CALL PRINTCHAR(DISPLAY(I)); 
END; 
DISPLAY(@) = 2; 
EDITSFLAG - FALSE; 
END DISPLAYSLINE; 


LOADSDISPLAY: PROCEDURE; 
IF DISPLAY(@) < 72 THEN 
PUE YN OPDISPLATUO):sDISPLAYW(O) % 1) - CHAR 
IF CHAR = “$° THEN EDITSFLAG = TRUE; 
CALL GETSCHAR; 
END LOADSDISPLAY; 


PUT: PROCEDURE; 
IF ACCUM(O) « ACCUMSLENG THEN 
ACCUM(ACCUM(@) :=ACCUM(@)+1)=CHAR3 
Chimie LOADS DISPLAY ; 

END PUT; 


EATSLINE: PROCEDURE; 
DO WHILE CHAR<OCR; 
CALL LOADSDISPLAY; 
END; 
END BATSLINE; 


GETSNOSBLANK: PROCEDURE; 
DECLARE (N,1) BYTES 
DO FOREVER; 
IF CHAR = ° “ THEN CALL LOADSDISPLAY; 
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ELSE 
IF CHAR=CR THEN 
DO; 
CALL DISPLAYSLINE; 
CALL PRINTSERROR(TRUE); 
IF SEQSNUM THEN N=8; ELSE N-2; 
DO I = 1 TO N; 
CALL LOADSDIS PLAY; 
END; 
ТЕ CHAR = °*° THEN CALL EATSLINE; 
ELSE 
IF CHAR = “2” TEEN 
DO; 
IF NOT DEBUGGING THEN CALL ZATSLINE; 
ELSE CALL LOADSDISPLAY; 
END; 
END; 
ELSE 
RETURN; 
END; /* END OF DO FOREVER */ 
END GETSNOS BLANK; 


SPACE: PROCEDURE BYTE; 
RETURN (CHAR=" “) OR (CEAR=CR); 
END SPACE; 


DELIMITER: PROCEDURE BYTE; 
/* CHECKS FOR A PERIOD FOLLOWED BY A SPACE OR CR¥/ 
IF CHAR <> “.” THEN RETURN FALSE; 
BOLD=NEXTSCEAR; 
LOOKED=TRUE; 
ШУ 5ЮАСЕ ТНЕМ 


ШО; 
СЕЕ"; 
RETURN TRUE; 
END; 
CERS T; 


RETURN FALSE; 
IND DELIMITER; 


ENDSOFSTOKEN: PROCEDURE BYTE; 
RETURN SPACE OR DELIMITER; 
END ENDSOFSTOKEN; 


GETSLITERAL: PROCEDURE BYTE; 
CALL LOADSDISPLAY; 
DO FOREVER; 
IF CHAR= QUOTE THEN 


DO; 
GALL BOWDSDISPLAY; 
RETURN LITERAL; 
END; 
CALL PUT; 


END; 
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END GETSLITERAL; 


LOOKSUP: PROCEDURE BYTE; 
DECLARE POINT ADDRESS, 
EERE BASED POINT (1) BYTE, 
I BYTS; 


MATCH: PROCEDURE BYTE; 
DECLARE J BYTE; 
DO 1-1 ТО АӨСПМм(0): 
= 1) <> ACCUM(J) THEN RETURN PFALSE; 


IF HERE(J 
END; 
RETURN TRUE; 
END MATCH; 


POINT=OFFSET(ACCUM(2))+ . TABLE; 
DO I=1 TO WORDSCOUNT( ACCUM(@)); 
IF MATCH THEN RETURN I; 
POINT = POINT + ACCUM(@);3 
END; 
RETURN FALSE; 
END LOOEKSUP; 


RESERVEDS$WORD: PROCEDURE BYTE; 
/* RETURNS THE TOKEN NUMBER OF A RESERVED WORD IF THR 
CONTENTS OF THE ACCUMULATOR IS A RESERVED WORD, OTHERWISE 
RETURNS ZERC */ 
DECLARE VALUE BYTE; 
DECLARE NUMB BYTE; 
IF ACCUM(O) > MAXSLEN THEN RETURN 3; 
IF (NUMB:=TOKENSTABLS(ACCUM(23)))=@ THEN RETURN 9; 
IF (VALUE:=LOOKSUP)=@ THEN RETURN g; 
RETURN (NUMB + VALUE); 
END RESERVEDSWCRD; 


GETSTOXEN: PROCEDURE BYTE; 
АССУМ(0)-д; 
CALL GETSNOSBLANK; 
IF CHAR=QUOTE THEN RETURN GETSLITERAL; 
ГЕ DELIMITER THEN 
DO; 
CALL PUT; 
RETURN PERIOD; 
END; 
DO FOREVER; 
CALL PUT; 
IF ENDSOFSTOKEN TEEN RETURN INPUTSSTR; 
END; /* OF DO FOREVER */ 
END GETSTOKEN; 


SCANNER: PROCEDURE; 
DECLARE CHECK BYTE; 
DO FOREVER; 
IF(TOKEN:=GET$TOKEN) = INPUTSSTR TEEN 
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IF (CHECK:=RESERVEDSWORD) <> Ø THEN ТОКЕМ=СНЕСК; 
IF TOKEN <> @ THEN RETURN; 
CALL PRINTSEZRROR ('SE^); 
DO WHILE NOT ENDSOFSTOXEN; 
CALL GETSCHAR; 
END; 
END; 
END SCANNER; 


PRINTSACCUM: PROCEDURE; 
ACCUM(ACCUM(@)+1)=°57;3 
GALL PRINT( .ACCUM(1)); 

END PRINTSACCUM; 


PRINTSNUMBER: PROCEDURE (NUMB); 
DECLARE(NUMB,I,CNT,X) BYTE, J(*) BYTE DAT4(10€,10); 
Dos; 270 1; 
CNT=9; 
BOMEILS NUMB >= (X:=J(1)); 
NUMB=NUMB ~ К; 
CNT=CNT 1; 
ЕМІ; 
CALL PRINTCHAR('9° + CNT); 
END; 
CALL PRINTCEAR('O! + NUMB); 
END PRINTSNUMRER; 


INITSSCANNER: PROCEDURE; 
/* INITIALIZE FOR INPUT - OUTPUT OPERATIONS 2 
DZCLARE CONSCEL (*) BITE DATA (’CBL’), 
I BYTE, 
TESTFLAG BIETE; 
CALL MOVE(FARMS,.PARMLIST,8); 
IF PARMLIST(@) = “$” TEZN 
DO; 
=: 
DO SHILE (TESTFLAG:=PARMLIST(I:=I1+1)) © * 7; 
[ORT ESTE AD “17 THEN LISTSINPUT=NOT LISTSINDUT; 
IF TESTFLAG 57 ТЕЗМ SEOQSNUM= NOT SEQSNUM; 
PRESTON ^P^ THEN PRINTSPROD = NOT PRINTSPROD; 
IF TESTFLAG ^T^ THEN PPINTSTOXEN = NOT PRINTSTOLEN 
END; 
END; 
CALL MOVE (.CONSCBL, INSADDR + 9, 3); 
CALL FILL(INSADDR + 12,0,5); 
CALL OPEN; 
CALL MOVE(INADDR, ЕЕ i 9); 
OUTPUTSFCB(32) = 
OUTPUTS END= рв. =, OUTPUTSBUFF - 1) + 128; 
САТЕ МАКЕ; 
CULL GETSCHAR? /* PRIME THE SCANNER */ 
IF SEQSNUM THEN 
ШІ - 1 70 6; 
CALL LOADSDISPLAY; 
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END; 
IF CHAR = '*" THEN CALL EATSLINE; 
CALL GETSNOSBLANK; 
CALL PRINTSERROR(PALSE); J = ON] Te Lig Ais ERROR 
MSG OUTPUT */ 
END INITSSCANNER; 


/* * * * END OF SCANNER PROCEDURES * * * ж/ 


LIEU MY SYMBOL TMBLE DECLARATIONS * # з= */ 


DECLARE 

CURSSYM ADDRESS, /*SYMBOL BEING ACCESSED*/ 
SYMBOL - BASED CURSSYM (1) BYTE, 
SYMBOLSADDR BASED CURSSYM (1) ADDRESS, 
NEXTSSYMSENTRY BASED NEXTSSYM ADDRESS, 

EASESPTR ALDRESS, 

SAVESADDR ADDRESS, 

DISPLACEMENT LIT Eo c 

HASHSMASK LIT “ЗЕН”, 

SSTYPE DIT op 

OCCURS Lm 112 R 

ADDR2 LIT a 

PSLENGTH LIT fe 

SSLENGTY DIT 47, 

ШЕТ ЕТ, IIT (оца 

DECIMAL LIT ST 

LOCATION EIT E 

RELSID LIT С 

STARTSNAME LIT 712, /=1 LBSS*/ 
MAXSIDSLEN VIT 12 


/* ж ж ж ж TYPE LITERALS * * X X wm m ox 7 


DECLARE 

SEQUENTIAL BET Er 

ENOSRELATIVE LIT 22r 

RANDOM LIT f. m 

VARIABLESLENG LIT са 

GROUP [ГТ "67, 

СОМР DIT Ка, 


/* * * * SYMBOL TABLE ROUTINES ж ж ож ж«/ 


INITSSYMBOL: PROCEDURS; 
/* INITIALIZE HASH TABLE AND FIRST COLLISION FIELD */ 
FREESSTORAGT = „MEMORY; 
ШАР (EREESSTORACE, 0,130); 
NEXTSSYM=FRESSSTORAGE+1283 
NXXTSSYMSENTRI-9; 

END INITSSYMBOL; 


GETSPSLENGTH: PROCEDURE BYTE; 
RETURN SYMBOL(PSLENGTE); 
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END GETS PSLENGTS; 


SETSADDRESS: PRCCEDURE( ADDR); 
DECLARE ADDR ADDRESS; 

SYMBOLS ADDR( LOCATION) =ADDR; 
END SETSADDRESS; 


GETSADDRESS: PROCEDURE ADDRESS; 
RETURN SYMBOLSADDR(LOCATION) ; 
END GETSADDRESS; 


GETSTYPE: PROCEDURE BYTE; 
RETURN SYMBOL(SSTYPE); 
END GETSTYPE; 


SETSTYPE: PROCEDURE(TYPE); 
DECLARE TYPE BYTE; 
SYMBOL(SSTYPE)=TYPE; 

END SETSTYPE; 


ORSTYPE: PROCEDURE(TYPE); 
DECLARE TYPE BYTE; 
SYMBOL(SSTYPE)=TYPE OR GETSTYPE; 
END ORSTYPE; 


GETSLEVEL: PROCEDURE BYTE; 
RETURN SYMBOL(LEVEL); 
END GETSLEVEL; 


SETSLEVEL: PROCEDURE (LVL); 
DECLARE LVL BYTE; 
SYMROL(LEVEL)=LVL; 

END SETSLEVEL; 


GETSDECIMAL: PROCEDURE BYTE; 
RETURN SYMBOL(DECIMAL); 
END GETSDECIMAL; 


SETSDECIMAL: PROCEDURE (DEC); 
DECLARE DEC BYTE; 
SYMBOL(DECIMAL)-DEC; 

END SETSDECIMAL; 


SETSSSLENGTH: PROCEDURE(EOWSLONG); 
DECLARE EOWSLONG ADDRESS; 
SYMBOLSADDR(SSLENGTH) = HOWSLONG; 

END SETSSSLENGTE; 


GETSSSLENGTH: PROCEDURE ADDRESS; 
RETURN SYMBOLSADDR(SSLENGTY);3 

END GRETSSSLENGTS; 

SETSADDR2: PROCEDURE (ADDR); 
DECLARE ADDR ADDRESS; 
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SYMBOLSADDR(ADDR2)-ADDR; 
END SETSADDR2; 


GETSADDR2: PROCEDURE ADDRESS; 
RETURN SYMBOLSADDR(ADDR2); 
END GET$ADDR2; 


SETSOCCURS: PRCCEDURE(OCCUR); 
DECLARE OCCUR BYTE; 
SYMBOL( OCCURS )=OCCUR; 

END SETSOCCURS; 


GETSOCCURS: PROCEDURE BYTE; 
RETURN SYMBCL (OCCURS); 
END GETS OCCURS; 


SETSIOSADDRS: PROCEDURE; 

SYMBOLSADDR(LOCATION) = NEXTSSYM; 

SAVESADDR = CURSSYM; 
END SETSIOSADD3S; 

LN M = PARSER DECLARATIONS Ж * = */ 
DECLARE 


INT MET "63, /* CODE FOR INITIALIZE */ 
SCD LIT бе E CODE TOR Sar CODE ETARTE, 
PSTACKSIZE LIT 30", /* SIZE OF PARS? STACKS*/ 
STATESTACK NESTACESTZIB) BYTE, /* SAVED STATES */ 
VALUE (PSTACKSIZE) ADDRESS, /* TEMP VALUES */ 
VARC (51) BYTE, /*TEMP CHAR STORE*/ 
IDSSTACK (10) ADDRESS INITIAL (g), 
IDSSTACKSPTR BITE ІМІТІАІ (0), 

HOLDSLIT (ACCUMSLENSPS1 ) BYTE, 

EOLD$S YM ADDRESS, 

PUINDINGSLITERAL Byte INITIAL( FALSE), 

PENDINGSLITSID ADDRESS, 

REDEF BYTE INITIAL (PALSE), 

REDEFSONE ADDRESS, 

REDEFS TWO ADDRESS, 

TEMPS HOLD ADDRESS, 

TEMPS TWO ADDRESS, 

COMPILING BYTE ENITIAL(TRUE); 

SP BYTE INITIAL (255), 

MP BYTE, 

MPP1 BYTE, 

NOLOOK BYTE PENIS TALK RU) 

EC J,.X) BYTE, /*INDICIES FOR TEE PARSER*/ 
STATE BYTE INITIAL(STARTS), 

VALUESFLAG BYTE INITIAL(FALSE), 

VALUESLEVEL BYTE INITIAL(2), 

TRUNCSFLAG BYTE INITIAL(TRUE); 


NL M o PARSER ROUTINES * = = ж F/ 


BYTESOUT: PROCEDURE(ONESBYTE); 
/* THIS PROCEDURE WRITES ONE BYTE OF OUTPUT ONTO THE DISX 
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IF REQUIRED THE OUTPUT BUFFER IS DUMPED TO THE DISK */ 
DECLARE ONESBYTE BYTE; 
IF (OUTPUTSPTR:=OUTPUTSPTR + 1)> OUTPUTSEND THEN 
Do; 
CALL WRITESOUTPUT; 
OUTPUTS PTR=.OUTPUTSBUFF; 
END; 
OUTPUTSCHAR=ONESBYTE; 
END BYTESOUT; 


STRINGSOUT: PROCEDURE (ADDR,COUNT); 
DECLARE (ADDR,I,COUNT) ADDRESS, (CHAR BASED ADDR) BYTE; 
DO 1-1 TO COUNT; 
CALL ZYTESOUT(CHAR); 
ADDR=ADDR+1; 
END; 
END STRINGSOUT; 


ADDRSOUT: PROCEDURE(ADDR); 
DECLARE ADDR ADDRESS; 
CALCE BYTESOUT(LOW(ADDR)); 
CALL BYTESOUT(HIGH(ADDR)); 
END ADDRSOUT; 


PILLSSTRING: PROCEDURE( COUNT,CHAR) 3 
DECLAFE (I,COUNT) ADDRESS, CHAR BYTE; 
ШО TO COUNT; 
CALL BYTESOUT( CHAR); 
END; 
END FILLSSTRING; 


STARTSINITIALIZE: PROCEDURE (ADDR ,CNT)}$ 
ПОПЕО АНИ ADDR. CNT) ADDRESS; 
BALD BY T SOUT( INT); 
CALL ADDRSOUT(ADDR) 3 
GALL ADDRSOUT(CNT); 
END STARTSINITIALIZE; 


BUILDSSYMBOL: PROCEDURE (LEN); 
DECLARE LEN 3YTE, TEMP ADDRESS; 
TEMP=NEXTSSYM; 
BEER Sy M2=.SYMBOL(LEN:S=LEN+DISPLACHMENT)) 
> MAXSMEMORY THEN CALL FATALSTRROR(’ST’) 
CALLO LL (TEMP, o, LEN); 
END BUILDSSYMBCL; 


, 


DUPSIDENSTEST: PROCEDURE; 
DECLARE I BYTE; 


IF REDEFSFLAG THEN 

DO; 
REDEFSFLAG = FALSE; 
RETURN; 

END; 
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ELSE 
IF FILESDESCSFLAG THEN 


20; 


END; 


ELSE 


END 


FILESDESCSFLAG = FALSE; 
I = 0; 
DO WHILE DUPSIDENSARRAY(I) <> 2; 
IF DUPSIDENSARRAY(I) = CURSSYM THEN 
DO; 
CALL PRINTSERROR( ‘DI’ ); 
RETURN; 
END; 
1 = I + 1; 
IF 1 > 23 THEN 
DO; 
CALL PRINTSERROR( ‘RF’ ); 
RETURN; 
END; 
END; 
DUPSIDENSARRAY(I) = CURSYM; 
RETURN} 


CALL PRINTSERROR( DI’); 
DUPSIDENSTEST; 


MATCH: PROCEDURE ADDRESS; 


CHECKS AN IDENTIFIER TO SEE IF IT IS IN THE SYMBOL 
TABLE. IF IT IS PRESENT, CURSSYM IS SET FOR ACCESS. 
OTHERWISE A NEW ENTRY IS MADE AND THE PRINT NAME 

IS ENTERED. ALL NAMES ARE TRUNCATED TO MAXSIDSLEN*/ 


DECLARE POINT ADDRESS, 
COLLISION BASED POINT ADDRESS, 
(HOLD,I) BYTE; 


IF VARC(BD)>MAXSIDSLEN 
THEN VAPC(@) = MAXSIDSLEN; 
/* TRUNCATE IF REQUIRED */ 
ПОЕ 
SAT IATA) /* CALCULATE HASH CODE */ 
EOLD=HOLD + VARC(I); 
END; 
POINT=FREESSTORAGE + SHL((EOLD AND HASESMASK),1); 
DO FOREVER; 
IF COLLISION=8 TEEN 
DO; 
IF FILESDESCSTLAG THEN 
DO; 
FILESDESCSFLAG = FALSE; 
CALL PRINTSERROR( “UI’); 
END; 
ELSE 
IF REDEFS FLAG THEN 
Do; 
REDEFSFLAG - FALSE; 
CALL PRINTSERROR( UI“); 
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END; 

CURSSYM,COLLISION=NEXTSS YM; 

CALL BUILD$SSYMBOL(VARC(9)); 

/* LOAD PRINT NAME */ 

SYMBOL(PSLENGTH )=VARC(Q);3 

DO І - 1 TO VARC(O); 
SYMBOL(STARTSNAME + I)=VARC(I); 

END; 

RETURN CURSSYM; 


END; 
ELSE 
DO; 
BURSSLMZCOLLISION; 
IF (HOLD:=GETSPSLENGTH )=VARC(@) TEEN 
DO; 
I=1; 
DO WEILE SYMBOL(STARTSNAME + I)= VARC(I);5 
E (I:=I+1)>HOLD THEN 
05 
CALL DUPSIDENSTEST; 
RETURN (CURSSYM:=COLLISION) ; 
END; 
END; 
END; 
END; 
POINT=COLLISION; 


END; 
END MATCH; 


ALLOCATE: PROCEDURE(BYTESSREQ) ADDRESS; 
/* THIS ROUTINE CONTROLS THE ALLOCATION OF SPACE 
IN THE MEMCRY OF THE INTERPRETER. */ 


DECLARE (HOLD,BYTESSREQ) ADDRESS; 
HOLD=NEXTSAVAILARLE; 
IF (NEXTSAVAILABLE:-NEXTSAVAILASLE + B3YTESSREQ) 
»MAXSINTSMEM 
THEN CALL FATALSERROR( °MO’); 
RETURN HOLD; 
END ALLOCATE; 


DIGIT: PROCEDURE (CHAR) BYTE; 

DECLARE CEAR BYTE; 

RETURN (CHAR <= '9') AND (CHAR >= g’); 
END DIGIT; 


SETSREDEF: PROCEDURE(OLD, NEW); 
DECLARE (OLD,NEW) ADDRESS; 
REDEFSONE=OLD; 
REDEFSTWO=NEW; 
REDEF-TRUE; 
END SET$REDEF; 


SETSCURSSYM: PROCEDURE; 
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CURSSYM-IDSSTACK(IDSSTACKSPT3); 
END SETSCURSSYM; 


STACKSLEVEL: PROCEDURE BYTE; 
CALL SETSCURSSYM; 
RETURN GETSLEVEL; 

END STACKSLEVEL; 


LOADSLEVEL: PROCEDURE; 
DECLARE HOLD ADDRESS; 


LOADSREDEFSADDR: PROCEDURE} 
CURSS YM=REDEFSON RB} 
HOLD=GETSADDRESS; 

END LOADSREDEFSADDR; 


IF IDSSTACK(@) <> @ THEN 


DO; 
ІР VALUE(SP-2)=@ THEN 
DO; 
CALL SETSCURSSYM; 
HOLD=GETSSSLENGTH + GETSADDRESS; 
END; 
ELSE 00; 
IF FILESSECSEND THEN 
DO; 
IF IDSSTACK(IDSSTACKSPTR) <> REDEFSONE 
THEN 
DO; 
CALC PRINTSERROR( RI); 
REDEFSONE=IDSSTACK(IDSSTACKSPTR); 
END; 
END; 
CALL LOADSREDEFSADDR; 
END; 
E (IDSSTACKSPTR:=IDSSTACKSPTR+1)>9 THEN 
9 
CALL PRINTSERROR( “RL” ); 
IDSSTACKSPTR=9; 
END; 
END; 


ELSE HOLD=NEXTSAVAILABLE; 
IDSSTACK(IDSSTACKSPTR)=VALUE(MPP1); 
CALL SETSCURSSIM; 
IF (GETSLEVEL = 1) AND (NOT FILESSECSEND) THEN 
CALL SETSADDR2(SAVESADDR); 
CALL SETSADDRESS(HOLD); 
END LOADSLEVEL} 


REDEFSORSVALUE: PROCEDURE; 
DECLARE HOLD ADDRESS, 
(pea. J,SICGN,CHAR) BYTE; 
IF REDEP TEEN 
Dos 
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IF REDEFSTWO=CURSSYM THEN 
50; 
HOLD=GETSSSLENGTH; 
CURSSYM=REDEFSONE; 
IF HOLDDGETSSSLENGTH THEN 


DO; 
CALL PRINTSERROR(/R2'); 
HOLD=GETSS SLENGTH; 
CURSSYM=REDEFSTWO; 
CALL SETSSSLENGTH(HOLD); 
END; 
END; 
END; 
ELSE IP PENDINGSLITERAL=9 THEN RETURN; 
IF (PENDINGSLITSID<>IDSSTACKSPTR) OR VALUESFLAG 
THEN RETURN; 
IF PENDINGSLITERAL <> @ THEN 
CALL STARTSINITIALIZE(GETSADDRESS , HOLD: =GETSSS LENGTH); 
IF PENDINGSLITERAL>2 THEN 
DO; 
IF PENDINGSLITERAL=3 TEEN CEAR="0“; 
ELSE IF PENDINGSLITERAL=4 THEN CHAR=" 7; 
ELSE IF PENDINGSLITERAL = 5 THEN CHAR = QUOTE; 
E FILLSSTRING( HOLD, CHAR); 
END; 
ELSE IF PENDINGSLITERAL = 2 THEN 
DO; 
IF HOLD <= HOLDSLIT(@) THEN 
СЕ RING SOUT( -HOLDSLI 0 (1) HOLD); 
ELSE DO; 
CALL SIRINGSOUT( .HOLDSLIT1),HOLD$LIT(Ø)); 
CALL FILLSSTRING (HOLD ~ HOLDSLIT(@),° ^); 
END; 
END; 
ELSE IF PENDINGSLITERAL=1 THEN 
DO; 
/* THE NUMBER HANDELER */ 
DFCLARE (DEC,MINUSSSIGN,I,J,LITSDEC,NSLENGTH, 
NUMSBEFORE,NUMSAFTER, TYPE) BYTE, 
ZONE LIT 108; 


IF((TYPE:=GETSTYPE)<16) OR (TYPE>21) THEN 
CALL PRINTSERROR(/NV^/); 

NS LENGTH=GETSSSLENGTH; 

DEC=GETSDECIMAL; 

MINUSSSIGN-FALSE; 

IF HOLUDSLIT(i) = °-° THEN 


MINUS$SIGN=TRUS; 
J=1; 

END; 

ELSE IF HOLDSLIT(1) = “+° THEN J=1; 
ELSE 7-0; 

LIT$DEC-0; 
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Dos SETOSHOLDSLIT(O); 
ИНТЕШЕРІТ(І)- 27 ТНҰМ ртторрсмер 


END; 


-4 , 
IF HOLDSLIT(@) <> @ THEN 
DO; 


у 
ІР 217305049 THEN 
, 
NUMSBEFORE-EOLDSLIT(0)-J; 
NUMSAFTER-0; 
END; 
ELSE DO; 
ж -1-1) 
NUMSAFTER=HOLDSLIT(8) - LITSDEC; 
END; 
END; 
ELSE IF HOLDSLIT(@) = @ THEN 
On 
NUMSBEFORE = 2; 
NUMS AFTER = 0; 
LITSDEC = 0; 
END; 
IF (I:=NSLENGTH — DEC)<NUMSBEFORE THEN 
CALL PRINTSERROR(’SL’); 
Er re Eon ТНЕМ 
, 
I=I-NUMSBEFORE; 
IF MINUSSSIGN THEN 
DO; 
І-І-1; 
CALL BYTESOUT(*G” + ZONE); 
END; 
МЕР ЕТІІ55ТВЕІМС(І, 07); 
210; 
ELSE IF MINUSSSIGN THEN HOLDSLIT(J+1) 
=ROLDSLIT(J+1)+ZONE; 
CALL STRINGSOUT( „BOLDSLIT(1)+J ,NUMSBEFORE); 
IF NUMSAFTER > DEC THEN NUMSAFTER = DEC; 
Conor aENGSOUTY .ROLDSLIT(1) + LITSDSC, NUMSAETER); 
IF (I:sDEC - NUMSAFTER)<>@ THEN 
CALL 9 IRLSSTRING(I, 07); 
END; 
IF NOT VALUESFLAG THEN PENDINGSLITERAL-2; 
END REDEFSORSVALUE; 


REDUCESSTACK: PROCEDURE; 
DECLARE HOLDSLENGTE ADDRESS; 
CALL SETSCURSSYM; 
CALL REDEFSORSVALUE; 
HOLDSLENGTH=GETSSSLENGTH}3 
IF GETSTYPE > 128 THEN 
Dor 
HOLDS LENGTH=HOLDSLENGTH * GETSOCCURS; 
END; 
IDSSTACKSPTR=IDSSTACKSPTR - 1; 
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ALL ETSCURSSIM; 
CALL SBISSSLENGTH(GETSSSLENGCT 
CALL SETSTYPE(GROUP ); 

END REDUCESSTACK; 
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ENDSOFSRECORD: PROCEDURE; 
DO WHILE IDSSTACESPTR <> 2; 
CALL SETSCURSSIM; 
CALL REDEFSORSVALUE; 
ID$STACK(IDSSTACKSPTEk)-20; 
IDSSTACKSPTR=IDSSTACKSPTR - 1; 
END; 
CALL SETSCUESSYM; 
CALL REDEFSORSVALUE; 
FOSSTACK (CH=; 
TEMPSHOLD=ALLOCATE( TEM PSTWO:=GETSSSLENGTH)} 
END ENDSOFSRECORD; 


CONVERTSINTEGER: PROCEDURE; 
DECLARE INTEGER ADDRESS; 
INTEGER=9; 
DO I = 1 TC VARC(O); 
IF NOT DIGIT(VARC(I)) THEN CALL PRINTSERRORE CNN’); 
/* BRROR RECOVERY FOR AN “0” WHICH SHOULD 
HAVE BEEN A ZERO--“0” */ 
IA VARC(I) = 0 ) THEN VARC(I) = 72; 
INTEGER=SHL(INTEGER,3)+SEL(INTEGER,1)+(VARC(I)-"3"); 
END; 
VALUE(SP)=INTEGER; 
END CONVERTSINTEGER; 


ORSVALUE: PROCEDURE(PTR,ATTRIB); 
DECLARE PTHR BYTE, ATTRIB ADD2ESS;5 
VALUE(PTR)=VALUE(PTR) OR ATTRIB; 

END ORSVALUS; 


BUILDSFCB: PROCEDURE; 
DECLARE TEMP ADDRESS; 
DECTARE BUFFER(11) 3YTE, (CHAR, I, J) BYTE; 
CALL FILL(.BUFFER,” *,11); 
E 
DO WHILE (J < 11) AND (I< VARC(@)); 
ПО GHAR -=VARC(IT:=I+1))="°.° THEN J=8; 
ELSE DO; 
BUFPER(J)=CHAR} 
Ј=Ј+1; 
END; 
END; 
CALL SETSADDR2( TEMP :=ALLOCATE( 165) )3 
GAG OTMRTOINITIALI ZE(TEMP,37); 
CDA BYTES CUT(O); 
CALL STRINGSOUT( .BUFFER,11)3 
GALE FILLSSTRING (25,0); 
CALL ORSVALUE(SP-1,1); 
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END BUILDSFCB; 


SETSSIGN: PROCEDURE(NUMB); 

DECLARE NUMB BYTE; 

IF GETSTYPE-17 THEN CALL SETSTYPE(VALUE(SP) + NUMB); 

ELSE CALL PRINTSERROR( “SG” ); 

IF VALUE(SP)<>@ THEN CALL SETSSSLENGTH(GETSSSLENGTY + 1); 


END SETSSIGNS 


NUMSTRUNC: PROCEDURE; 

DECLARE I BYTE, 
Т BYTE, 
TRUNCSTYPE BYTE, 
TRUNCSZERO BYTE, 
SIGNSFLAG BYTE, 
DECSFLAG BITE, 

TRUNCSZERO = TRUE; 

SIGNSFLAC = FALSE; 

DECSFLAG = FALSE; 

HOLD SLIT) = 2; 

y = т; 

Ш- 7. 


Pn ORUNCSTYPES=GETSTYPE)=16) ОР 
21) THEN 


(TRUNCSTYPE = 


(TRUNCSTYPE=17) OR 


DO WHILE J <= VARC(@);3 


IP (VARC(J) <> 
DOR 
IF (VARC(J 
ELSE " x 


)= 2 £ 
аг Cl 
9 )) O 
е: 
D 


) 


IF DECSFLAG AND 
CALL PRINTSERROR( 


ELSE DO; 


EOD VO E 


) 
Ј 
R 


5 7) 
— 


TIEN 
AND TRUNCSZERO THEN J=J; 


)e»s ^9 7) AND (VARC(S) 


“) THEN 


(VARC(J) = 
"MD'); 


TON 


EOLDSLIT(HOLDSLIT(0):-EOLDSLIT(2) *1) 
sVARC(J); 


IF VARC(J) <> 
IF VARC(J) = *. 


°@° THEN TRUNCSZERO = 
^ THEN DECSFLAG = 


FALSE; 
TRUS; 


= ет; 
END; 
END; 
ELSE IF ((VARC(J) < °°) OR (VARC(J) > (ur AND 
(VARC(J) <> 7.7) THEN CALL PRINTSERROR( NN”); 


END; 


ELSE IF SIGNSFLAG THEN CALL PRINTSERROR( MS’); 


UM NE TARO(J) = ^-^) OR (VARC(J) = /^-*) TEEN 
DOS 
IF TRUNCSTYIPE - 16 TEEN CALL PRINT$zRa30R('SG'); 
ELSE DO; 
HOLDSLIT(HOLDSLIT(@) s=HOLDSLIT(@)+1)=VARC(J); 
SIGNS FLAG = TRUS; 
1 = I +1; 


TOM 








END; 
END; 
= + 1) 
END;/* DO WHILE LOOP */ 
EU = I; 
AND 
)) 


Ei T(9) = 1) (ROLD LITON =" H 
НООТ) =- =°) OR (HOLDSLIT(D) => 2“) THEN 
DO; 

HOLDSLIT(8) = 0; 

HOLDSLIT(1) = €; 

END; 


END NUMSTRUNC; 


PICSANALIZER: PROCEDURE; 
DECLARE /* WORK AREAS AND VARIABLES #/ 


FLAG BYTE, 
FIRST Bis, 
COUNT ADDRESS, 
BUFFER (31) BYTE, 
SAVE Ре 
REPITITIONS ADDRESS, 
J ADDRESS, 
DECSCOUNT BITE, 
CHAR BITE, 
I BYTE, 
TEMP ADDRESS, 
ТТРЕ BITE; 
DECSFLAG BYTE, 
K ENS 


ALPHA ral: 


/* ж ж MASKS ж ж ж/ 

Mos 

ASEDIT Ро 
Де, 


ASN Dra 

EDIT „т x 

NUM LIT 167. 

NUMSNDNTINDIT. 32, 

DEC LIT 2647, 

SIGN БЕГ 128", 

NUMSMASK LIT Talol аз 
NUMSEDSMASK LIT "190001013", 
SSNUMSMASK LIT “001011118”, 
ALPHASMASK DT ТИТА 
ASESMASK LIT "11111100B , 
ASNSMASK ЕТТ 71110102103”, 
ASNS ESMASK ШЕТ 711120400038”, 
/ж ТҮРЕ5 */ 


NETYPE LIT “80”, 
ПЕТРЕ LIT “16°, 
SNEY PS. LIT 717 
АТҮРЕ LIT “8”, 
RETIPE LIT 7727, 
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Mic Drei tT 97, 
PIE Pe LIT 73°; 


INCSCOUNT: PROCEDURE(SWITCE); 
DOCCA RE SWITCE BYTE; 
FLAG=FLAG OR SWITCE; 
СОШ СОЛИ) < 31 THEN 3USBER (COUNT) 
= CREAR; 
END INCSCOUNT; 


CHECK: PROCEDURE (MASK) BYTE; 
/* THIS ROUTINE CHECKS A MASK AGINST THE 
FLAG RYTE AND RETURNS TRUE ID THE FLAG 
HAD NO BITS IN COMMON WITE THE MASK */ 
DECLARE MASK BYTE; 
POUR NNO (FLAG AND MASK) <> 2); 

END CHECK; 


PICSALLOCAT?: PROCEDURE(AMT) ADDRESS; 
DECLARE AMT ADDRESS; 
ІР (MAXSINTSMEM:=MAXSINTSMEM - AMT) 
< NEXTSAVAILABLE 
THEN CALL FATALSERROR (“MO”); 
RETURN MAXSINTEMEM; 
END PICSALLOCATE; 


/* PROCEDURE EXECUTION STARTS HERE */ 


CURSSYM = HOLDSSYM; 

IF (GETSLEVEL = VALUESLEVEL) THEN VALUESFLAG = FALS 
DECSFLAG = FALS#; 

COUNT, FLAG ,DECSCOUNT=@; 

/* CHECK FOR EXCESSIVE LENGTH */ 

IF VARC(@) > 350 THEN 

DO; 


tj 


CALL PRINTSERROR('/PC/); 
RETURN; 
END; 
/* SET FLAG BITS AND COUNT LENGTH */ 
= 
DO WHILE I<=VARC(I); 
IP (CHAR:=VARC( 
ELSE IF CHAR =’ 


I))=’A’ THEN CALL INCSCOUNT(A4LPHA); 

B° THEN CALL INCSCCUNT(ASEZDIT); 

ELSE IF CHAR ="S9° THEN CALL INCSCCUNT(NUM) ; 

ELSE IF CHAR s/X' TEEN CALL INCSCOUNT(ASN); 

ELSE IF (CHAR=°S’) AND (COUNT=2) THEN 
FLAG=FLAG OR SIGN; 

ELSE IF (CHAR = 77”) AND (DEC$SCOUNT=@) THEN 


un wu 


D0; 
DECSCOUNT = COUNT; 
PECSFLAG = TRUE; 
END; 
ELSE IF(CHAR="/°) OR (CHA22'2') THEN 
CALL INCSCOUNTS( EDIT) 3 


27.9 








END; 


ELSE IF 
(CHAR=°Z°) OR (CHAR=",*) OR (CHAR="*") OR 
(CHAR="+") OR (CHAR="-") OR (CHAR="5“) THEN 
CALL INCSCOUNT(NUMSEDIT); 
ELSE IF (CHAR=’.°) AND (DECSCOUNT-2) THEN 
DO; 
CALL INCSCOUNT(NUMSEDIT); 
DECSCOUNT=COUNT; 
DEGCE LAG = THUS! 
END; 
ELSE [ТЕ ((СНАН= С“) AND (VARC(I+1 
mo» AND (VARC(I+1)=" 
, 
CALL INCSCOUNT(NUMSEDIT); 
CHAR=VARC(Is=I+1)3 
CALL INCSCOUNT(NUMSEDIT); 
END; 


ELSE IF (CHAR="(°) AND (COUNT<>@) TEEN 


3 
SAVE=VARC(I-1); 
REPITITIONS=@;3 
DO WEILE(CEAR3=VARC(I:=1+1))<>*)%; 
REPI TITIONS=SHL(REPITITIONS,3) + 
SEL(REPITITIONS,1) %(СНА? -707); 
END; 
CHAR=SATE; 
Do J=1 TO REPITITIONS-1; 
CALL INCSCOUNT(@); 
END; 
END; 
ELSE DO; 
CALL PRINTSERROR(’PC’); 
RETURN; 
END; 
I=I +l; 
/* END OF DO WHILE I<= VARC #/ 


/* AT THIS POINT TEE TYPE CAN BE DETERMINED */ 


IF 


NOT CHECK(NUMSEDIT) THEN 
DO; 


IF CHECK(NUMSEDSMASEK) THEN TYPEZSNEITIP-; 


END; 


ELSE 
ELSE 
ELSE 
ELSE 
ELSE 
ELSE 


IF CHECK(NUMSMASK) THEN TYPE=NTYPE; 

IF CHECK(SNUMSMASK) THEN TYPE=SNTYPE; 
IF CHECK(ALPHASMASK) THEN TYPE = ATYPE; 
IF CHECK(ASESMASK) THEN TYPE = AZTYPE; 
IF CEECK(ASNSMASK) TEEN TYPE-ANTYPE; 

IF CHECK(ASNSESMASK) TUEN TYPE-ANZTYPE; 


IF TYPE=@ THEN CALL PRINTSERROR( PC”); 


ELSE 


DO: 
Ји сетоттрие=128) THEN CALL SETSTYIPXS(128*TYPZ); 
ELSE CALL SETSTYPE(TYPE); 
CALL SETSSLENGTH(COUNT + GETSSSLENGTH); 
IF (TYPE AND 64) <> @ THEN 
DO; 








CALL SETSADDR2(TEMP:=PICSALLOCATE(COUNT)); 
CALL STARTSINITIALIZE(TEMP,COUNT); 
CALL STRINGSOUT(.BUFFER + 1,COUNT); 
END; 
IF (DECSCOUNT <> 8) OR DECSFLAG TREN 
ро; 
IF (COUNT - DECSCOUNT) > 18 THEN 
CALL PRINTSERROR( “DC’); 
CALL SETSDECIMAL(COUNT — DECSCOUNT); 


END; 
END; 
IF (NOT TRUNCSFLAG) AND ((TYPE = 16) OR (TYPE = 17)) THEN 
©; 


ПОК = 8 TO HOLDSLIT(2); 
ПЛАНК) = HOLDSLIT(K); 
END; 
CALL NUMSTRUNC; 
BRUNCSELAC = TRUR; 
END; 
END PICSANALIZER; 


SETSFILESATTRIB: PROCEDURE; 
DECLARE TEMP ADDRESS, TYPE BYTE; 
IF CURSSYM<>VALUE(MPP1) THEN 
DO; 
TEMP=CURSSYM; 
CURSSYM=VALUE(MPP1); 
SYMBOLSADDR(RELSID)=TEMP; 
END; 
IF NOT (TEMP:=VALUE(SP-1)) THEN CALL PPINTS®REOR (°NF’)3 
ELSE DO; 
IF TEMP=1 THEN TYPE=SEQUENTIAL; 
ELSE IF TEMP=15 THEN TYPE=RANDOM; 
ELSE IF (TEMP=5) OR (TEMP=13) THEN 
ТҮР® = SEQSRELATIVE; 


BLSE DO; 
CALL PRINTŠERROR(’IA’); 
Т_РЕ=1; 
END; 
END; 


CAMES ETSTYIFE(TITPE); 
END SETSFILESATTRIB; 


LOADSLITERAL: PROCEDURE(LITSONE); 
DECLARE 1 BYTE, 
LITSONE PIE», 
LITSTYPE BYTE; 


БЕРЕ = CETSTYPE; 
IF LITSTYPE <> @ THEN VALUESFLAG = FALSE; 
ELSE DO; 

VALUR- STAC = TRUE; 

YÄLUESLEVEL = GET$LEVEL; 

END; 


Lol 





ТЁ РЕМРЇНЧНС$1Ї1ТЕ®ЕВА1], <> а THEM GALL PRINTSREROR ('LE^)j 
ELSE IF (LITSONR = Ø) OR (LITSTIYPF = 0) TER 
DOS 
DO I = 2770 NARCO): 
HOLDSLIMI) = VARC(I); 
END; 
IF (LITSONE = 1) AND (LITSTYPE = Ø) TREN 
TRUNCSFLAG - FALSE; 
END; 
ELSE IF (LITSONE = 1) AND ((LITSTYPE = 16) OR 
(ТЕТӨЛУРЕ - 127) ОР (CLITSTYPE =» 21)) THEN 
CALL NUMSTRUNC; 
ЕНІН Ін (ETT ONE - 1) AND ((LITSTYPR <> 16) OR 
Geir orwes <> 17) OR (LITSTYSS <> 21)) BND 
(LITSTYPE <> 2) THEN 
DO; 


CALL PRINTSERROR( “LV” ); 

ПОЕ ТАТО С (ай): 
POCDSLIT(I) = WMEC(]); 

END; 

PENDINGSLITERAL = 2; 

END; 


END LOADSLITERAL; 


REDEFSTEST: PROCEDURE; 

DECLARE SAVESREDEF BYTE, 
SAVESREDEFSONS ADDRESS, 
SAVESREDEFSTWO ADDRESS; 

SAVESREDEFSONE = REDEFSONE; 

SAVESREDEFSTWO = REDEFSTWO; 

REDEFSONE = CURSSYM; 

CALL SETSCURSSYM; 

REDEFSTWO = CURSSYM; 

SAVESREDEF = REDEF; 

REDEF = TRUE} 

CALL REDEFSORSV4LUB; 

IDSSTACK(IDSSTACKS PTR) = 2; 

IDSSTACKSPTR = IDSSTACKS?TR - 1; 

REDEFSONE = SAVESREDEFSONE; 

REDEFSTWO = SAVESREDEFSTWO; 

REDEF = SAVESREDEF;} 

END REDEFSTEST; 


CHECKSLVLSFILES: PROCEDURE; 
DECLARE NEWSLEVEL BYTE; 
EOLDS$SYM,CURSSYM-VALUE(M?-1); 
CALL SETSLEVEL(NEWSLEVEL:-VALUS(MP-2)); 
IF NEWSLEVEL - 1 THEN 
DO; 
IF IDSSTACK(@) <> 9 TAN 
DO; 
ПОШТЕ STACKSLEVEL > 1; 
CALL REDUCESSTACK; 
END; 


ez 








DO WHILE IDSSTACKSPTR <> Ө; 
CLL SERSCURSSYM; 
CALL REDEFSORS VALUE; 
IDSSTACK(IDSSTACKSPTR) = Ø; 
IDSSTACKSPTR = IDSSTACKSPTR - 13 
END; 
CURSSYM = HOLDSSIM; 
CALL SETSREDEF(IDSSTACK(0) ,VALUE(MP-1)); 
VALUE(MP) = 15/* SET REDEFINE FLAG */ 
END; 
END; 
ELSE DO WHILE STACKSLETEL »s NEWSLEVEL; 
CALL REDUCESSTACK; 
END; 
END CHECKSLVLSFILES; 


CHECKSLVLSWORK:  PROCEDURS; 

DECLARE NEWSLEVEL BITR 
SAVESSYMSLVL BYTE. 
STACK$REDUCED BYTE, 

S AVESREDEF ВҮТЕ, 
SAVESSYM ADDRESS; 


SETSVALUESCLAUSE: PROCEDURE; 
SAVESREDEF = REDEF; 
REDEF = FALSE; 

CALL SETSCURSSYM; 

CALL REDEFSORSVALUE; 

REDEF = SAVESREDEF; 

CURSSYM = EOLD$3STM; 
END SETSVALUES CLAUSE} 


mauNCSFLAG = TRUE; 
EDACXSREDUCED - FALSE; 
HOLD$SYM,CUR$S YM-VALUE(MP-1); 

CALL SETS$LEVEL(NEWSLEVEL:-VALUE(M?-2)); 

IP NEWSLEVEL - 1 THEN 

50; 
DO WHILE STACKSLEVEL > 1 AND IDSSTACK(IDSSTACKSPT=) <>8; 
SAVESSYM,CURSSYMSIDSSTACK(IDSSTACKSPTR - 15; 
ENWVESSYMSLUVL = GETSLEVEL; 

IF SAVESSYMSLVL = STACKSLEVEL THEN 

DO} 

CURSSYM = SAVESSYM; 

CALL REDEFSTEST; 

END; 

ELSE LF STACKSLEVEL > 1 THEN 

DO; 

ENDE RBEDUCESSTACK; 

BESVALUESFDAG AND (VALUESLEVEL - STACEKSLEVEL) 
DO; 

VALUESFLAG = FALSE; 

CALL SETSVALUESCLAUSE; 

END; 


3 
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END; 
END;/* DO WHILE LOOP */ 
IF STACKSLEVEL = 1 AND IDSSTACKSPTR <> @ THEN 
DO; 
CURSSYM = IDSSTACK(IDSSTACKSPTR - 1); 
GALL REDEFSTEST; 
END; 
IF VALUE(MP) = @ AND IDSSTACK(IDSSTACKSPTR) <> Ø THEN 
DO; 
CALL ENDSOFSRECORD; 
REDEF = FALSE; 
END; 
IF (VALUE(MP) = 1) AND (IDSSTACK(IDSSTACKS°TR) = REDEFSONS) 
BEEN CALL SETSVALUESCLAUSE; 
CURSSYM = HOLDSSYM; 
END; 
ELSE IF STACKSLEVEL >= NEWSLEVEL THEN 
DO; 
IF (STACKSLEVEL = NEWSLEVEL) AND (VALUE(MP) = 1) AND 
(IDSSTACK(IDSSTACKSPTR) = REDEFSONE) THEN 
CALL SETSVALUESCLAUSE; 
DO WHILE NOT STACKSREDUCED; 
SAVESSYM,CURSS YM=IDSSTACK(IDSSTACKSPTR - 1); 
SAE SSYMSLVL = GETSLEVEL; 
IF SAVESSYMSLVL = STACKSLEVEL TEEN 
DO} 
CURSSYM = SAVESSYM; 
CALL REDEF$TEST; 
END; 
ENSE IF (STACKSLEVEXL >= NEWSLEVEL) AND 
(VALUE(MP) = @) THEN 
DC; 
DO WHILE STACKSLEVEL >= NEWSLEVEL; 

CALL REDUCSSSTACK; 

IF VALUESFLAC AND (VALUESLEVEL=STACKSLEVZL) 
AND (VALUESLEVEL = NEWSLEVEL) THEN 


DO; 
VALUESFLAG = FALSE; 
CALL SETSVALUESCLAUSE; 
END; 
END;/* DO WHILE LOOP */ 
STACKSREDUGED = ТРПЕ: 
END; 
monly (STACKSLEVEL >= NEWSLEVEL) AND 
(VALUE(MP) = 1) THEN 
00; 
DO WEILE STACKSLEVEL > NEWSLEVEL; 
CALL REDUCESSTA&CK; 
IF VALUESFLAG AND (VALUESLEVEL = STACKSLEVEL) 
THEN DO; 
VALUESFLAG = FALSE; 
CALL SETSVALUESCLAUSE; 
END; 
END; /* DO WHILE LOOP */ 
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STACKSREDUCED = TRUS; 
END; 
END;/* DO WHILE LOOP */ 
END; 
CURSSYM = HOLDSSYM; 
END CEECKSLVLSWORK; 


CODESGEN: PROCEDURE( PRODUCTION); 
DECLARE PRODUCTION BYTE, 
LITSTYPE ЗҮТЕ; 
IF PRINTSPROD THEN 


DO; 

САТ. СЕБЕ; 

CALL PRINTCHAR (POUND); 

CALL PRINTSNUMBER( PRODUCTION); 
END; 


DO CASE PRODUCTION; 
BRUCE TIONS#/ 
/* CASE 0 NOT USED EN 
(* 1 PROGRAM» ::2 <ID-DIV> <2-DIV> <D-DIV> PROCEDURES */ 
COMPILING= =FALST 


BEER D auos 
CALL PRINT(.DISPLAY(1)); 
END; 


/* 2 <ID-DIV> ::= IDENTIFICATION DIVISION . PROGRAM-ID .*/ 
y* 2 (COMMENT? . <AUTH> <DATE> <SEC> */ 

; /* NO ACTION REQUIRED */ 
ЦЕЛО CAUTE» ::- AUTHOR . COMMENT? . x: / 

; /* NO ACTION REQUIRED */ 
/* 4 — 5! <ҰМРТТОЫ ~ 

5 /* NO ACTION REQUIRED */ 

/* 5 <DATE> ::= DATE-WRITTEN . <COMMENT> . * / 

/* NO ACTION REQUIRED */ 

6 — \! EMPTY > ы 
/* NO ACTION REQUIRED */ 
ПА СЕ з= SECURITY . <COMMENTD . ж/ 
/* NO ACTION REQUIRED Y 
8  \! <EMPTY> ж / 
/* NO ACTION REQUIRED */ 

9 <COMMENT> ::= <INPUT> * / 

/® NO ACTION REQUIRED */ 
/*19 \1 «COMMENT? <INPUT> x 
/* NO ACTION REQUIRED */ 
/Ж11 <E-DIV> 2:= ENVIRONMENT DIVISION . CONFIGURATION */ 
/*11 SECTION . <SRC-OBJ> <I-O> */ 

>; /*® NO ACTION REQUIRED */ 
/*12 <SRC-OBJ> ::= SOURCE-COMPUTER . «COMMENT» <DFRUGD .*/ 
/*12 OBJECT-COMPUTER . <COMMENT> . = 

; /* NO ACTION REQUIRED */ 


~~ RE 
de we dene demo ave 


we jee 3 
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/*13 <DEBUG> ::= DEBUGGING MODE ж/ 

DEBUGGING=TRUE; /* SETS A SCANNER TOGGLE */ 
a \! <EMPTY> vi 

: /* NO ACTION REQUIRED */ 
/*15 <I-0> ::= INPUT-OUTPUT SECTION . FILZ-CONTROL . */ 


/*15 <FILE-CONTROL-LIST> <IC> * / 
; /* NO ACTION REQUIRED */ 
/#16  \! <EMPTY> ж/ 


; /* NO ACTION REQUIRED */ 
fer <P TLE=CONTHOL-LIST> ::= <FILE-CONTROL-SNTRYD */ 
; /* NO ACTION REQUIRED */ 


718 MIS EDESCCONTROL-LQST» BÀ 
7218 <FILE-CONTROL-ENTRY> */ 

; /* NO ACTION REQUIRED */ 
ES SFI LS-CONTROL-ENTRYD ::= SELECT <ID> 


С ИШИ ВЕБЕ =/ 
CALL SETSFILESATTRIB; 


/Я20 <ATTRIBUTE-LIST> ::= <ONZ-ATTRIB> т 
; /* NO ACTION REQUIRED */ 
/*21 \! <ATTRIBUTE-LIST> <ONE-ATTRIBD */ 


VALUE(MP)=VALUE(SP) OR VALUE(MP); 
/*22 CONE-ATTRIB> ::= ORGANIZATION <ORG-TYPZ> 27 
VALUE(MP)=VALUE(SP); 


/*23 \! ACCESS <ACC-TYP®> <RELATITED> */ 
VALUE(MP)SVALUE(MPP1) OR VALUE(SP); 
/*24 \! ASSIGN <INPUT> у 

CALL BUILDSTCB; 
/*25 <ORG-TIPE> ::= SEQUENTIAL f 

5 /* NO ACTION REOUIRED - DEFAULT */ 
/ж26 XI RELATIVE an 

CALL ORSVALUE(SP,4); 
7*27 SACC-TYPED ::= SEQUENTIAL = 


; /* NO ACTION REQUIRED - DEFAULT */ 
20 НИНА ИО ж 

CALL ORSVALUE(SP,2); 
Sa <RELATIVE) ::= RELATIVE <ID) = 


CALL ORSVALUE(MP,8); 
/*30 ер? А 
; /* NO ACTION REQUIRED - DEFAULT */ 
ШІ <ІС> ::- I-O-CONTROL . <5АМ%-1157> m 
) 
582 ENE Y i 
) 
fee <SAMR—-LIST? ::- <SAME-ELEMENTD ж/ 
/ж54 NIESSAMEZLIST) <SAMBBL EMBNT > КА 
) 
SS <SAME-ELEMENT> ::= SAME <ID-STRINGD . “у 
) 
ЕОС LD-STRING> ::= <ID> и 


) 
[* 37 М! <ID-STRING> <ID> “и 


) 
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/#38 <D-DIV> ::= DATA DIVISION . <FILE-SECTION> <WORK> */ 
/*38 <LINK> ^ 

: /* NO ACTION REQUIRED */ 
/*39 <FILE-SECTION> ::= FILE SECTION . <FILE-LIST> */ 
FILESSECSEND = TRUE; 


/*4Q \1 <EMPTY> ur 

FILESSECSEND=TRUE; 
/*41 <FILE-LIST>D ::= <FILES> = 

; /* NO ACTION REQUIRED */ 
/*42 ӘР ШІН-ГІСІ?> <ҮІТ55> И 

; /* NO ACTION REQUIRED */ 
GAS <FILES> ::= FD <ID> <FILE-CONTROL> . ay 
/*4% <RECORD-DESCRIPTION> 37 

DO; 


DO WHILE STACKSLEVEL > 1; 
CALL REDUCESSTACK; 
END; 
CALL ENDSOFS RECORD; 
REDEF=FALS 8; 
END; 
/*44 <FILE-CONTROL> ::= <FILE-LIST> ж/ 
CALL SETSIOSADDRS; 
/ж45 NI <EMPTY> 2 
CALL SETSIOSADDRS; 
/*46 <PILE-LIST> ::= <FILE-ETLEMENT>D ж/ 
; /* NO ACTION REQUIRED */ | 
*47 AMI <FILE-LIST> <PILE-ELEMENT> * / 
; /® NO ACTION REQUIRED */ 
/*48 <FILE-"SLEMENT> ::= BLOCK <INTEGERD RECORDS ж/ 
; /* NO ACTION REQUIRED – FILZS NEVER BLOCKED */ 
/*49 \t RECORD <REC-COUNT> ж/ 
CALL SETSSLENGTR(VALUE(SP)); 
/*50 NI LABEL RECORDS STANDARD */ 
; /* NO ACTION REQUIRED */ 
/*51 \! LABEL RECORDS OMITTED */ 
; /* NO ACTION REQUIRED */ 
/*52 \! VALUE OF <ID-STRING> = 
; /®* NO ACTION REQUIRED */ 
P55 <REC-COUNT> ::= <INTEGERD у 
; /* NC ACTION REQUIRED - VALUE(SP) CORRECT */ 
 %64 МІ <ІМТЕСЕН> ТО <ІХТЕСЕК» * / 
DO} 
VALUE(MP)=VALUE(SP); /* VARIABLE LENGTH */ 
UNDEDSSETSTYPE(4); /* SET TO VARIABLE */ 


END; 

72555 <WORK> ::= WORKING-STORAGE SECTION . Е 
OO <RECORD-DESCRIPTION> = 

DO; 


DO WHILE STACKSLEVEL > 1; 
URSS TA = TDSSTACK(IDSSTACKSPTR - 1); 
IN GETSLEVEL = STACKSLEVEL THEN 
CALL REDEFSTEST; 
ELSE 1h STACKSLEVEL > 1 THEN 
CALL REDUCESSTACK; 
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END; 

IF STACKSLEVEL = 1 AND IDSSTACKSPTR <> @ THEN 
DO; 

CURSSYM = IDSSTACK(IDSSTACKSPTR - 1); 

IF REDEF THEN CALL REDEFSTEST; 


END; 
CALL ENDSOFSRECORD; 
END; 
/*56 NX! <EMPTY> ж/ 
; /* NO ACTION REQUIRED */ 
/*57 <LINK> ::= LINKAGE SECTION . <RECORD—DESCRIPTIOND */ 
CALL PRINTSERROR('NI/^); /* INTER PROG COMM */ 


/*58 X1 <EMPTY> * / 

; /* NO ACTION REQUIRED */ 
/*59 «RECORD-DESCRIPTION» ::-2 <LEVEL-ENTRY> ж/ 

; /* NC ACTION REQUIRED */ 
/*60 NV! <RECORD-DESCRIPTION> */ 
/*6@ <LEVEL-ENTRY > * / 

: /* NO ACTION REQUIRED E 
/#61 <LEVEL-ENTRY> ::= <INTEGER> <DarTa-ID> <REDEFINTS> */ 
/*61 £DATA-TYPES * / 

DO; 


CALL LOADSLEVEL; 
IF (PENDINGSLITERAL <> Ø) AND (NOT VALUESFLAG) TEEN 
PENDINGSLITSID = IDSSTACKSPTS;3 
END; 
/*62 <DATA-ID> ::= <ID> ж/ 
; /* NO ACTION REQUIRED 7 
/*63 \! FILLER ж / 
ШО; 
CURSSYM, VALUE(SP)=NEXTSSYM; 
CALL BUILDSSYMBOL(@); 
END; 
/*64 <REDEFINES> ::= REDEFINES <ID> * / 
DO; 
CALL SETSREDEF(VALUE(SP) ,VALUE(SP—2)); 
VALUE(MP )=15 /* SET REDEFINE FLAG ON */ 
IF NOT FILESSECSEND THEN 
CALL PRINTSERROR( 23”); 
GAEL CHYCKSLVLSWORK; 
END; 
> \l <EMPTY> * / 
) 
IF NOT FILESSECSEND THEN 
ALL CHECKSLVLSPFILES; 
BLSE CALL CHECKSLVLSWORK; 
END; 
/*66 <DATA-TYP2> ::= <PROP-LIST> ж / 
; /* NO ACTION REQUIRED */ 
/*67 \! <EMPTY> 4 
» /* NO ACTION REQUIRED */ 
/*68 <PROP-LIST> ::= <DATA-TLEMENT> ү 
5 /* NO ACTION REQUIRED */ 
/*69 X! <PROP-LIST> <DATA-2LEMENT> x 


188 








: /* NO ACTION REQUIRED */ 
/*70 <DATA-ELEMFNT> ::= PIC <INPUT>D * / 
CALL PICSANALIZER; 
/#71 NI USAGE COMP ж/ 

CALL SETSTYPE(COMP); 
/*72 MÍ USAGE DISPLAY “/ 

; /* NC ACTION REQUIRED - DEFAULT */ 
/жФ3 \! SIGN LEADING «SEPARATE» u; 
CELL SETSSICN (17); 
/%7 4 \f SIGN TRAILING <SEPARATED И 
CALL SET$SIGN(18); 
/*75 X1 OCCURS <INTEGER> “и 

ро; | 
CALL ORSTYPE( 128); 

CALL SETS$OCCURS(VALUE(SP)); 
END; 


/*76 NUS TENE <DIRECTION> = 
; /* NO ACTION REQUIRED - BYITE MACHINE */ 
/*77 \! VALUE <LITERAL> 27 
DO; 
IF NOT FILESSECSEND THEN 
DO}; 


CALL PRINTSERROR( VE”); 
PENDINGSLITERAL-9; 


BAD; 

END; 
/*78 «DIRECTION? ::- LEFT ми 
; /* NO ACTION REQUIRED */ 
/*79 О ТЕНТ i 

5 /* NO ACTION REQUIRED */ 
/* 8 M <EPPTY> =/ 

; /* NO ACTION REQUIRED */ 
Peed <SEPARATE> ::= SEPARATE n 
VALUE(SP)=2; 
/*82 \! <EMPTY> =) 

› /®* МО ACTION REOUIRED */ 
ЕЗ <LITERAL> ::= <INPUT>D и 
DO; 


ІР ((LITSTYPE:=GETSTYPE) <> 16) AND 
МАНИ Ко 17) АМР (1,175ТТРЕ <> 21) ТНЕМ 
DO; 

CALL PRINTSERROR( NV”); 
CALL LOADSLITERAL(0); 
POMDINGSLITERAL = 2; 
END; 

mos DO; 

GALL, LOADSLITHRAL(1) 
PENDINGSLIT?RAL = 1; 
END; 

END; 

/%84 Neer То */ 

DO; 

Cate LOADSLITERAL(2) ; 
PENDINGSLIT *RAL-2; 








END; 
/*85 ІТ ЕКС % / 
PENDINGSLITERAL-3; 
/*86 М! SPACE ж/ 
PENDINGSLITERAL-24j; 
/*87 \!? QUOTE ж/ 
PENDINGSLITERALS5; 
/*88 <INTEGER> ::= <INPUT> n 
CALL CONVERTS INTEGER; 
/*89 <ID> ::= <INPUT> ay) 
VALUE(SP)=MATCH; /* STORE SYMBOL TABLE POINTERS */ 


END; /* END OF CASE STATEMENT */ 
END CODESGEN; 


GETIN1: PROCEDURE BYTE; 
RETURN INDEX1 (STATE); 
SND GETINI; 


GETIN2: PROCEDURE BYTE; 
RETURN INDEX2(STATE); 
END GETIN2; 


INCSP: PROCEDURE; 

SP=SP + 1; 

MAS. >= PSTACKSIZE THEN CALL FATALSERROR( SO”); 
VALUE(SP)=@; /* CLEAR VALUE STACK */ 
END INCSP; 


DUPSIDENSFLAG: PROCEDURE; 
IF TOKEN = 92 THEN FILESDESCSFLAG = TRUS; 
IF TOKEN = 47 THEN REDEFSFLAG = TRUE; 

END DUPSIDENSFLAG; 


LOOKAHEAD: PROCEDURE; 
IF NCLOOK THEN 
DO; 
CALL SCANNER; 
CALL DUPSIDENSPLAS; 
NOLOOK-FALSE; 
IF PRINTSTOKEN THEN 
ро; 
CALL CRLF; 
CALL PRINTSNUMBZR(TOKEN); 
GALL PRINTSCHAR(^ ^); 
CALL PRINTSACCUM; 
END; 
END; 
END LOOK4HEAD; 


NOSCONFLICT: PROCEDURE (CSTAT!S) BITE; 
ШШДЕ (CSTAIS,I,J,K) BYTE; 





J=INDEX1(CSTATE); 
K=J + INDEX2(CSTATE) - 1; 
DO I=J TO K; 
IF READ1(I)=TOKEN TEEN RETURN TRUE; 
END; 
RETURN FALSE; 
END NOSCONFLICT; 


RECOVER: PROCEDURE BYTE; 
DECLARE (TSP, RSTATE) BYTE; 
DO FOREVER; 
TSP=SP; 
DO WHILE TSP <> 2555 
IF NOSCONFLICT(RSTATE:=STATESTACK(TSP)) THEN 
DO; /* STATE WILL READ TOKEN */ 
IF SP<>TSP THEN SP = TSP — 1; 
PETUEN RSTATE; 


END; 

ISE Lor = 1; 

END; 

CALL SCANNER; /* TRY ANOTHER TOKEN */ 
END; 


END RECOVER; 


ENDSPASS: PROCEDURE; 
/* THIS PROCEDURE STORES THE INFORMATION REQUIRED ЗҮ 
PARTZ IN LOCATIONS ABOVE THE SYMBOL TABLE. TEE FOLLOWING 
INFORMATION IS STORED: 

OUTPUT FILE CONTROL BLOCK 

COMPILER TOGGLES 

INPUT BUFFER POINTER 
THE OUTPUT BUFFER IS ALSO FILLED SO THE CURRENT RECORD. 
ШӘ WRITTEN */ 


CALL BYTESOUT(SCD); 

CALL ADDRSOUT(NEXTSAVAILABLE); 

DO WHILE OUTPUTSPTR<>.OUTPUTSBUFF; 
CALL BYTSSOUT(@FFEH); 

END; 


CALL MOVE( .OUTPUTSFCB,MAXSMEMORY—PASS1SLEN,PASSI$LEN)? 
L: GO TO L; /* PATCH TO ЈМР 31868 */ 

END ENDSPASS; 

/* * * * * PROGRAM EXECUTION STARTS EEPE * ж ж/ 

CALL MOVE(INITIALSPOS ,MAXSMEMORY ,RDRSLENGTY); 


CALL INITSSCANNER; 
CALL INITSSYMBOL; 


JE * ж ж о ж ож ж DARSTR Ж Ж 9% ж ж/ 


DO WHILE COMPILING; 
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IF STATE <= MAXRNO THEN /* READ STATE */ 
DO; 
CALL INCSP; 
STATESTACK(SP) = STATE; /* SAVE CURRENT STATE */ 
CALL LOOKAHZAD; 
DeGETIN1; 
МИ – GETING — 1; 
DO I=I TO J; 
IF READ1(I) = TOKEN THEN 
DO; 
/* COPY THE ACCUMULATOR IF IT IS AN INPUT 
STRING. IF IT IS A RESERVED WORD IT DCES 
NOT NEED TO BE COPIED. */ 
IF (TOKEN=INPUTS$STR) OR (TOKFN=LITERAL) THEN 
DO K=8 TO ACCUM(@); 
VARC(K )=ACCUM(K ); 
END; 
STATE=SREAD2 (I); 
NOLOOK=TRUE; 
I, 
END; 
ELSE 
IF I=J THEN 
DO; 
CALL PRINTSERROR( NP”); 
CALL PRINT(.(% ERROR NEAR $“)); 
CALL PRINTSACCUM; 
IF (STATE:=RECOVER)=8 THEN COMPILING=FALS®B; 
END; 
END; 
END; /* EIND OF READ STATE */ 
ELSE 
IF STATE>MAXPNO THEN /% APPLY PRODUCTION STATE */ 
DO; 
MP=SP - GETIN2; 
MPP1=MP + 1; 
CALL CODESGEN(STATE — MAXPNO); 
SP=MP; 
ISCGETINI; 
J=STATESTACK(SP); 
PO WHILE (Ke=APPLY1(1)}) <> д МБ Је; 
Шер 1; 
END; 
IF (K:=APPLY2(I))=9 TEEN COMPILING=FALSS; 
STATE=K; 
END; 
EUST 
IT STATE<=MAXLNO THEN /*LOOKAHEAD STATE*/ 
0: 


, 
I=GETIN1; 
CALL LOOKAHEAD; 
DO WHILE (K:=LOOK1(I))<>@ AND TOKEN <>dZ;3 
I=I+1; 
END; 
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STATE=LOOK2(1); 

END; 

ELSE 

ene 7* PUSH STATES*/ 
CALL INCSP; 
STATESTACK(SP)-GETIN2; 
STATE=GETIN1; 

END; 

END; /* OF WHILE COMPILING */ 

CALL ENDSPASS; 

END; 
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PART2: /* MODULE NAME */ 
DO; 


/* COBOL COMPILER - PART 2 */ 
/* 100H = MODULE LOAD POINT */ 
/* GLOBAL DECLARATIONS AND LITERALS */ 


DECLARE LIT LITERALLY “LITERALLY “3 DECLARE 
ENSSISLEN LIT 748”, 
MAXSMEMORY LIT '2D199H/, 
РА5515ТОР LIT '0OD?COOHR', 
GR LIT 13° 
NEELIT 712”, 
ОООТЕ LIT 276, 
POUND LIT ‘23H’, 
BUE LIT 717, 
PALSE LIT а“, 
FOREVER LIT “WHILE TRUE’, 
ALPHASLITSFLAG BYTE INITIAL(FALSE), 
IFSFLAG BYTE INITIAL(FALSE); DECLARE MAXRNO LITERALLY 
^82',/* MAX READ COUNT */ 
IO LITERALLY 185 ,/* MAX LOOK COUNT */ 
MAXPNO LITERALLY /120' ,/* MAX PUSH COUNT */ 
ЕО Е АА 219 ,/* MAX STATE COUNT */ 
MORTS LITERALLI “1°;/* START STATE */ 
DECLARE READ1(*) BYTE 
Rp geo. 5,0,9,14,16,22,22,24, 26,51,52.41,42,44,45 ,49,55 
‚54,5@,6@,48, 2а, 12729, 26,29,38,37,48,59, Do 46 
EST 13,28,29 E EIS M 42, 25 49, 57, 858 2:52 4243 22 15 
155,50,52,64,18,4,58,28,59,48 INE 10559 
mime 20022524 ,26,51,41,42,44,45,49,53,54 
ЙЕН |60,51,7,17,1,1 
КО |11 16 207,21,22,24,26,31,41,42,44,45,49,53,54 
,04,58,60,48,62,8,18,25,0,0); 


DECLAR? LCOK1 ( * :) БУТЕ 

ПО 7 а. 42. 0,2,8,40,0,1,15,9,43,2,350,43,0,2,0,27,2,7 
ЕЕЕ 1 15 2,55 0,55,2,55,2,52,0,1,18,2,12,2,1,0,51,0 
КО ой); д, бо S 4а 

DECLARE APPLY1(*) RTLS 


DATA(0,0,22,2, Ad 11, 070,51, 0,11 58/06, 24103 6 РО ВО 
Mel, 0, ,29,0,2,8,0, 57, 52, 59, 0, д, 2, dU dcc Ua uou 


‚5,7, а, 15, 14 yaa ‚2, 5,6,7,8,12,13,14,18.21,23,24.26 
К.га 55 5! ,20,44,75, 76 СО ико о Васо о со 
МЕ 7 = 15,14,22,44,9,52,9 ,20,2,0,15, О о Са mu 
81,2,0); 


DECLARE READ2(*) BYTE 
По 416 ,212,9,14,85,15,17,18,29,25,24,27, u ee ei 
2155.04, 37, Ser ERICH S. cds 221, 295, 207, 226,85,178, RS E 


B8 185 ШІ ма 207. = Бе ag cnc l29) 25,291 
E Oo. 5.,35,4 ‚129,188, ІС? LOS 556 3161. 162, 14.5 
ШЕН, 201, с. 35, oOo, cs i Са, 174,184,6,9,12 ‚85 


SEEN ШЕ 727,25,27,22,29,50,52,55,54,57,58,184,6,15,1,50 
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ПОЛ 6 .9,12 fee tS 16017 13,20 же та SO 
Ин а 37.328. 19,8,40,121,198,19,7,8): 
DECLARE LOOK2(*) BYTE 

DATA(9,12,106 ,22,197,198,199,36,108,142,142,124,44,199,45 
ти а 45.196 ,47 ,111,112 ,49,113,52 ,114,114,54,56,115,57 
‚116,58 Пон | [= 119.119,23,64,120,147,67,59.139,75 
22 78,1356,128,128,81); 
DECLARE APPLY2(*) BYTE 

ШИПА 2 2,157,67,76,105,77,127,126,105,73,72,1951,150,152 
Marg 4 Oo 152,155,104 194,156,102 ,102,1359,182,74,169,48 

165. 155,193 205654154 148,68.154.61.94,145 65.175 
,79,159,55,186,890,96,144,97,98 el M OCA DEO 
,87,90,90,215,90,90,217,179,138,88,124,89,90 ‚157,91 
eto. 125,125, 42, 145,43,92,5¢ ,51,93,203,293,535,211 
НСВ. 105 195,155,195,195,2722,71,728,2208,212,171,52 

ЕНГІ 15 165,120 ,140,141,101,101,147,82); 
DECLARE INDEX1(*) BYTE 

ШТ о 2. 22,115.115,115,115,25,25,753,115,115,115, 
MS 55056 115 ,44,115,115,26,115,115,115,115 

Re. 42,26,115 НЕ 15 20028 255 о 
ШЕ 50 115,51,850,525,54,23,59,60,23,61,62,65, ,66,66,66 
СИСТ БА 69.26.70 ,26.75,71,735,91,92,95,94 ,93,96,115,115,117 
ПР 57115 2 26,1,2,5,7,9,12,14,17,19,21,23,25,28,50,532 

ШЕ 56,59, баттоо толту губ тсз? те 
,187,180,204,204,185,170,170,170,170 Mog cs Р 
ПИК 7,7, 9,9,12,10,10,12,12,.12,12,12,12,12,12,12,12, 
M2 e 18,18,18,19,19,19,19,22,22,22,29,27,27,27 
,28,28,29,29 A A MEO S5 OMS 
,38,39,39,39,49,42,13,43,41,44 АО А5 бас шыша? 
,47,54,55,890,862,82,88,96,96,98,98,98,120,100,190 

Ма 101 1026 126,107 ,127,108,111); 
ТЕСТАНЕ ІЧГЕТ2(%) BYTE 
КЕБЕ 1 .1.1,1, 


"> 
+3 


А 
. an 


са. OUS н (ло 
Q- + (Лә + © v 
ә н Сл О о г Сл = 
ба • о с СА оњ P 
ho 
a 
U 
= 
= 
= 


> 
* 


pont OF TABLES */ 
DECLARE 
P= JOUNPS DECLARATIONS */ 
/* THE FOLLOWING ITEMS ARE DECLARED TOGSTHSER ІЧ Т 
ОО ОШО ОКЕ ТО FACILITATE THEIR BEING PASSED FRI 
И РАНО ОР ТЕБЕ COMPILER. 
i 
OUTPUTSFCB SS ВУ A 
DEBUGG ING EN. 
PRINTS PROD БҮЛҮ; 
PRINTSTOKEN BYTE, 





LISTSINPUT РУТ, 
SEQSNUM BIRRE, 
NEXT$SYM ADDRESS, 
POINTER ADDRESS, /* POINTS TO THE NEXT BYTE 
TO BE READ */ 
NEXTSAVAILABLE ADDRESS, 
MAXSINTSMEM ADDRESS, 
HASHSTARSADDR ADDRESS, /* ADDRESS OF THE BOTTOM OF 
TRE TABLES FROM PART1 */ 


/* 1 O BUFFERS AND GLOBALS */ 
INSADDR ADDRESS INITIAL (SCH), 
INPUTFCB BASED INADDR (33) BYTZ, 


OUTPUTSBUFF (128) BIOS 
OUTPUTSPTR ADDRESS, 
DUDPUTSEND ADDRESS, 


OUTPUTSCHAR BASED OUTPUTSPTR BYTE; 
/* MESSAGES FOR OUTPUT #/ 


DECLARE 
ERRORSNEARSS (*) BYTE DATA (^ ERROR NEAR 5^), 
ENDSOFSPARTS2(*) BYTE DATA (^ END CF COMPILATION $“); 


/* GLOBAL COUNTERS */ 
DECLARE 

СТЕ BYTE, 

ASCTR ADDRESS, 

BASE ADDRESS, 

BSBYTE BASED BASE BYTS, 

BSADDR BASED BASE ADDRESS; 


MON1: PROCEDURE (F,A) EXTERNAL; 
CLARE E BYTE, A ADDRESS; 
END MONI; 


MON2: PROCEDURE (F A) BYTE EXTERNAL; 
CLARS F BYTE, A ADDRESS; 
END MON2; 


BOOT: PROCEDURE EXTERNAL; 
END BCCT; 


PRINTCHAR: PROCEDURE (CHAR); 
DECLARE CHAR BYTE; 
CALL MON1 (2,CHAR); 

END PRINTCHAS; 


CRLF: PROCEDURE; 
ШІ РЕТКТОНАЯ(СВН); 
CALL PRINTCHAR(LFE); 
END CRLF; 


PRINT: PROCEDURE (A); 
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mecuAgs A ADDRESS; 
CALL MON1 (9,4); 
END PRINT; 


PERINTSERROR: PROCEDURE (COD); 
/* THIS PROCIDURE IS USED TO PRINT COMPILER ERRORS 70 
THE CONSOL */ 
DECLARE CODE ADDRESS, 
I BITE, 
CODE1(6) ADDRESS; 
IF CODE = FALSE THEN 
DO; 
DOMES TO 5; 
созо ту = 0; 


END; 
І = 2; 
END; 
ELSE 
IF CODE = TRUE THEN 
DC; 
1 = @; 


DORVELLELKI<>6) AND (CODEI(T) <> 8)); 
БЕШПЕНТ; 
CALL PRINTCEAR(EIGE(CODE1(1))); 
CALL PRINTCIAR (LOW(CODE1(1))); 
(ОДЕ) = 2; 
1 = 1 + 1; 
END; 
I = ø; 
END; 
ELSE 
IF (CODE = NP’) OR (CODE = МУ”) OR (CODE = 517) 
50; 
БАШЫ СТЕ: 
CALL PRINTCEAR(HIGE(CCDE)); 
CALL PRINTCH:2( LOW(CODE)); 


-3 
бо 
taj 
= 


END; 
ELSE 
DO; 
Iu cb TEEN 
DO; 
CODE1(I) = CODE; 
ШЕГІ + 1; 
END; 
END; 


END PRINTSERROR; 


FATALSERROR: PROCEDURE( REASON); 
DECLARE ?EASON ADDRESS; 
CALL PRINTSERROR (REASON); 
CALL PRINTS@RROR( TRUE); 
ШЕШІ ТІМЕ(10); 
GALL BOOT; 

END FATALSERROR; 
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CLOSE: PROCEDURE; 
ЖЕГІСІ ТБ. .ОШТІРПТ5ЕСВ)-255 ТИНЕМ CÁELL FATALSERROR( CL’); 
*ND CLOSE; 


MORESINPUT: PROCEDURE 8175; 
/* READS THE INPUT FILE AND RETURNS TRUE IF A RECORD 
WAS READ. FALSE IMPLIES END CF FILE */ 
DECLARE DCNT BYTE; 
IF (DCNT:=MON2(22,.INPUTSFCB))>1 THEN 
CALL FATALSERROR( “BR'); 
RETURN NOT(DCNT); 
END MORESINPUT; 


WRITESOUTPUT: PROCEDURE (LOCATION); 
/* WRITES OUT A 128 BYTE BUFFER FROM LOCATION*/ 
DECLARE LOCATION ADDRESS; 
CALL MON1(26,LOCATION); /* SET DMA */ 
IF MON2(21,.CUTPUT$FCB)<>0 THEN CALL FATALSERROR( WR”); 
CALL MON1(26,80H): /*RESET DMA */ 

END WRITESOUTPUT; 


MOVE: PROCEDURE(SOURCE, DESTINATION, COUNT); 
/* MOVES FOR THE NUMBER OF BYTES SPECIFIED BY COUNT */ 
DECLARE (SOURCE,DESTINATION) ADDRESS, 
(SSBYTE BASED SOURCE, DSBYTE BASED DESTINATION, COUNT) 
BYTE; 
ENEJSPLE (COUNT:COUNT — 1) <> 255; 
DSBYTE=S5 BYTE; 
SOURCE=SOUFCE +1; 
DESTINATION = DESTINATION + 1; 
ENT; 
END MOVE; 


FILL: PROCEDURE(ADDR,CEAR,COUNT) ; 
/* MOVES CEAR INTO ADDR FCR COUNT 3YTES */ 
DECLARE ADDR ADDRESS, 
(CHAR,COUNT,DEST BASED ADDR) BYTES; 
DO WHILE (COUNT:=COUNT -1)<>255; 


DES TECER; 
ADDR=ADDR + 1; 
END; 
END FILL; 
/® ж ож ож x * SCANNER LITS * * * * */ 
DZCLARE 
ИТЕ РАТ, LLT 729”, 
ШОО 5 Пт “48°, 
PERIOD [nm 1 
RPARIN DT a 
LPARIN LIT can 
INVALID LIT 95 


ПОШАО SCANNER TABLES * * X ko x/ 
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DESEE TOKENSTABLE (*) BYTE DATA 
/* CONTAINS THE TOKEN NUMBER ONZ LESS THAN THE FIRST 
RESERVED WORD FOR SACH LENGTH OF WORD */ 
ewe, +, lo,co,41,48,56,69,63), 


ШКО (*) BYTE DATA( BY’, °GO’, IF’, “T0’, “SOF”, “ADD”, “END” 
, 1-0 ЫНШЫ” САР,” ELSE , EXIT”, 2204, INTO” 
mEESS , MOVE’ ‚ ERs OPEN, PAGE PEAD, SIZE „~S ROP" 
ШЕНЕП”, ZERO’ , AFTER’, CLOSE’, ENTER’, EQUAL, TROR” 
BE INPUT’, QUOTE’, SPACE" , Byes’, UNTIL”. US NC Welln 
МИ ОЕРТ , BEFORE’, DELETE’ , DIVIDE’, OUTPUT’, DISPLAT 
, GREATER” , INVALID”, “NUMERIC”, “PERFORM”, “REWRITE” 
MROUNDED , SECTION’ < DIVISION ‚ MULTIPEY , SENTENCE 
BeSUBTRACT’ . ADVANCING’, “DEPENDING”, “PROCEDURE” 
M ALPHABETIC’), 
ENRSET (11) ADDRESS INITIAL 
/* NUMBER OF BYTES TO INDEX INTO THE TABLE FOR 

EACH LENGTH */ 
woe, 8,256,935 ,146,176, 2352, 264,291), 


WORDSCOUNT (*) BYTE DATA 
/* NUMBER OF WORDS OF EACE SIZE */ 
АРА 15,12,9,8,4,3,1), 


MAXSIDSLEN LIT кугын 


MAXSLEN BIT К. 

ADDSEND ОДНЕ ЮАТА (Or ^), 
LOOKED Pere INITIAL (9), 

HOLD PITE, 

EOFFILLER ШТ СТАН 

EUFFERSEND ADDRESS INITIAL (1008), 
NEXT BASED POINTER пүүр 
INRU?F ME: “айн”, 

CHAR үт INITIL 7. 


ACCUM (82) BYTE, 
ВИРТ (S82) BYTE INITIAL (@), 
ТОКЕН BITE; /*RETURNED FROM SCANNER */ 


* PROCEDURES USED 3Y THE SCANNER */ 


NEXTSCHAR: PROCEDURE BYTE; 
ІР LOOKED THEN 
00, 
LOOXED=FAISE; 
RETURN (CEAR:=HCLD); 
END; 
Pe (POINTERS =POINTER + 1) >= SUFFERSSND THEN 
DC; 
IF NOT MORESINPUT TEE 
DO; 
BUFFERSEND=.MEMORY; 
POINTER=.ADDSEND; 
END; 
ELSE POINTER=INBUFF; 


Jd 





END, 
IF NEXT = EOFFILLER THEN 


DO; 
BUFFERSEND = „MEMORY; 
POINTER = .ADDSEND; 
END; 


RETURN (СНАВ:-МЕТТ); 
END NEXTSCHAR; 


GETSCHAR: PROCEDURE; 
/* THIS PROCEDURE IS CALLED WHEN A NEW CHAR IS NSEDED 
WITHOUT THE DIRECT RETURN OF THE CERARACTER*/ 
CHAR=NEXTSCHAR; 

END GETSCHAR; 


DISPLAYSLINE: PROCEDURE; 
IF NOT LISTSINPUT THEN RETURN: 
ПОРТА DISPLAY{Q@) + 1) = “5%; 
CALL PRINT(.DISPLAY(1)); 
DISPLAY(@)=9; 

END DISPLAYSLINE; 


LOADSDISPLAY: PROCEDURE; 
IF DISPLAY(@)<&9 THEN 
DISPLAY(DISPLAY(@) :=DISPLAY(@)+1 )=CHAQ;} 
CALL GETSCEAR; 
END LOADSDISPLAY; 


PUT: PROCEDURE; 
IF ACCUM(@) < &@ THEN 
ACCUM( ACCUM(@) :=ACCUM(@)+1)=CHAR; 
PALL LOADSDISPLAY; 

END PUT; 


EATSLINE: PROCEDURE; 
DO 4HILE CHARC?CR; 
ALL LOSDSDISPLAY; 
END; 
END EATSLINE; 


GETSNOSBLANK: PROCEDURE; 
DECLARE (N,I) BYTE; 
DO FOREVER; 
Decne = THEN CALL LOADSDISPLAY; 
ELSE 
FE CEAR-CR THEN 
DO; 
CALL DISPLATSLINE; 
CALL PRINTSERROR(TRUZ); 
IF SECSNUM THEN N=8; ELSZ N=25 
nomi = 1 TO N; 
CALL LCADSDIS PLAY; 
END; 
IF CHAR = “*” THEN CALL FATSLINE; 
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ZND; 
ES 
FEICFEAR = °: THEN 
50; 
IF NCT DEBUGGING THEN CALL EATSLIN®E; 
ELSE 
CALL LOADSDISPLAY; 
END} 
ELSE 
RETURN; 
END; /* END OF DO FOREVER */ 
END GETSNOS BLANK; 


SPACE: PROCEDURE BYTE; 
RETURN (CHAR=" ^) OR (CHAR=CR); 
END SPACE; 


LEFTSPARIN: PROCEDURE BYTE; 
RETURN CHAR = (7; 
END LEFTSPARIN; 


RIGHTSPARIN: PROCEDURE BYTE; 
RETURN CHAR = 7); 
END RIGHTSPARIN; 


DELIMITER: PROCEDURE BITE; 
/* CEECKS FOR A PERIOD FOLLOWED BY A SPACE OR CR*/ 
IF CEAR <> °.” THEN RETURN FALSE; 
HOLD=NEXT$CEAR; 
LOOKED=TRUE; 
IF SPACE TEEN 


DO; 
СЕВЕ; 
&ETURN TRUE; 
END; 
CHAR= . 3; 


RETURN FALSE; 
ЕМІ DELIMITER; 


ENDSOFSTOKEN: PROCEDURE BYTE; | 
RETURN SPACE OR DELIMITER OR LEFTSPARIN OR RIGHTSPARIN; 


END ENDSOFSTOKEN; 


GETSLITERAL: PROCEDURE BYTE; 
CALL LOADSDISPLAT; 
DO FOREVER; 
IF CEAR = QUOTE THEN 
DO; 
CALL LOADSDISPLAY: 
RETURN LITERAL; 
END; 
CALL PUT; 
END; 
END GETSLITERAL; 


201 





LOOKSUP: PROCEDURE BYTE; 
DECLARE POINT ADDRESS, 
НЕН БАЗЕ) POINT (1) BYTE, I BYTE; 


MATCH: PROCEDURE BYTE; 
DECLARE J BYTE; 
ПОШ 70 АСОПМ(0); 
x HERE(J - 1) <> ACCUM(J) THEN RETURN FALSE; 
END; 
RETURN TRUE; 
END MATCH; 


POINT=OFFSET(ACCUM(®) )+ .TABLE; 
DO I=1 TO WORDSCOUNT(ACCUM(9)); 
IF MATCH THEN RETURN I; 
POINT = POINT + ACCUM‘); 
END; 
AETURN FALSE; 
END LOOKSUP; 


RESERVEDSWORD: PROCEDURE BYTE; 
/* RETUENS THE TOKEN NUMBER OF A RESERVED WORD IF TEE 
CONTENTS OF THE ACCUMULATOR IS A RESERVED WORD, 
OTHERWISE RETURNS ZERO */ 
DECLARE VALUE BYTE; 
DECLARE NUMB BITE; 
IF ACCUM(Q) <= MAXSLEN THEN 
DO; 
IP (NUMB:=TOKENSTARLE(ACCUM(B)))<>0 TEEN 
DO; 
IF (VALUE:=LOOX$U2) <> @ THEN 
NUMB=NUMB + VALUS; 
ELSE NUMP=0; 
END; 
END; 
ELSE NUM2-0; 
RETURN NUMB; 
END RESERVEDSWORD; 


GETSTOKEN: PROCEDURE BYTE; 
ACCUM(0)=0; 
CALL GETSNOS BLANK; 
IF CHAR=QUOTE TEEN RETURN GETSLITERAL; 
BECDELIMITER THEN 
DO; 
CALL PUT; 
RETURN PEPIOD; 
END; 
I? LEFTSPARIN THEN 
00; 
CALL PUT; 
RETURN LPARIN; 
END; 
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IF FIGHTSPARIN THEN 
DO; 
CALE PUT; 
RETURN RPAPIN; 
END; 
DO FOREVER; 
CALL PUT; 
IF ENDSOFSTOKEN THEN RETURN INPUTSSTR; 
END; /* OF DO FOREVER */ 
END GETSTOKEN; 
/* END OF SCANNER ROUTINES */ 
/* SCANNER EXEC */ 
SCANNER: PROCEDURE; 
IF(TOKEN:=GETSTOKEN) = INPUTSSTR THEN 
IF (CTR:=RESERVEDS WORD) <> 4 THEN TOXEN=CTR; 

END SCANNER; 

PRINTSACCUM: PROCEDURE; 
АССПМ(АССОМ(0)%1)- 97% 

BALL PRINT(.ACCUM(1));5 

END PRINTSACCUM; 

PRINTSNUM3ER: PROCEDURE (NUMB); 
DECLARE(NUMB,I,CNT,X) BITE, J (*) BYTE DATA(1290,12); 
ШІ 1-2 TO 1; 

TO 
DO WHILE NUMB >= (K:=J(1)); 
NUMB=NUMB - XK; 
CNT=CNT + 1; 
END; 
CALL PRINTCEAR( “0” + CNT); 
END; 
CALL PRINTCH!2(°@” + NUMB); 

END PRINTSNUMBER; 

/* * * * END OF SCANNER PROCEDURES * * * #/ 
/* ж ж ж * SYMBOL TABLE DECLARATIONS * * * ж/ 

DECLARE 

CURSSYM ADDRESS, /J*SYMBOL BEING ACCESS ED*/ 

SYMBOL BASED CURSSYM (1) BYTE, 

SYMBOLSADDR BASED CURSSYM (1) ADDRESS, 

NEXTSSYMSENTRY BASED NEXTSSYM ADDRESS, 


HASESMASK T ar, 
S$TYPE ТҮР о 
DISPLACEMENT DIT ЭК 
OCCURS LIT M. 
PSLENGTH LIT а, 
FLDSLENGTH DET AD 
LEVEL LIT BE 
D*CIMAL EIT в. 
RELSID ШТ 4 
LOCATION LIT d 
STARTSNAME EIT (0127. /*1 1®55*/ 
FCBSADDR [ГЕТ E 
/* * * * * ж ж STMBOL TYPE LITERALS * * * * x * x/ 
UNRESOLVED ШЕП СБ” 
LABELSTYPE pum Ec 


ГӘ 
сә 
CA 








MULTSOCCURS LIT сга, 


GROUP DAT '6', 
NONSNUMERICSLIT LIT MON. 
ALPHA LIT a 
ALPHASNUM DIT E 
Ше: LIT °10° 
LITSQUOCTE EIT obey 
LITSZERO ІІІ Ста 
NUMERICSLITERAL LIT 7157, 
NUMERIC LIT 716” 
СОМР BIT 21, 

ASED BIT ae 
ASNSED LIT 2 
NUMSED LIT “ga” 


/* * * * SYMBOL TABLE ROUTINES х ж ж ж 
SETSADDRESS: PROCEDURZ(ADDR); 
DECLARE ADDR ADDPESS; 
SYMBOLSADDR( LOCATION) =ADDR;} 
END SETSADDRESS; 
GETSADDRESS: PROCEDURE ADDRESS; 
RETURN SYMBOLSADDR(LOCATION); 
END GETSADDRESS; 
GETSFCBSADDR: PROCEDURE ADDRESS; 
RETURN SYMBOLSADDR‘(FCRSADDR); 
BND GETSFCBSADDR; 
GETSTYPE: PROCEDURE BYTE; 
RETURN SYMROL(SSTYPE); 
END GETSTYPE; 
SETSTYPE: PROCEDURE(TYPE); 
DECLARE TYPE BYTE; 
SIMBOL(SSTYPE)STYPE; 
END SETS TYPE; 
GETSLENGTH: PROCEDURE ADDRESS; 
RETURN SYMBOLSADDR(FLDSLENGTE); 
END GETSLENGTH; 
GETSLEVEL: PROCEDURE BITE; 
RETURN SYMBOL(LEVEL); 
END GETSLEVEL; 
GETSDECIMAL: PROCEDURE BYTE; 
RETURN SYMBOL(DE*CIMAL); 
END GETSDECIMAL; 
GETSPSLENGTH: PROCEDURE BYTS; 
RETURN SYMBOL( PSLENGTE) 3 
END GETS PSLENGTH; 
BUILDSSYMBOL: PROCEDURE(LEN); 
DECLARE LEN BYTES, TEMP ADDRESS; 
TEMP=NEXTSSYM; 
IF (NEXTSSYM:=.SYMBOL(LEN:=LEN + DISPLACEMENT) ) 
> MAXSMEMORY TEEN CALL FATALSERROR( ST); 
Bebe FILL (TEMP.2,LEN); 
END BUILDSSYMBOL; 
ANDSOUTSOCCURS: PROCEDURE (TYPESIN) BYTE 
DECLARE TYPESIN BYTE; 
RETURN TYPESIN AND 127; 
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END ANDSOUTSOCCURS; 
/* ж ж ж PARSER DECLARATIONS * * * ж/ 
DECLARE 
PSTACKSIZE LIT d 0 2 /* SIZY OF PARSS STARCKS*/ 
VALUE (PSTACKSIZE) ADDRESS, /* TEMP VALUES */ 
STATESTACK (PSTACKSIZE) BYTE, /* SAVED STATES */ 
VALUE2 (PSTACKSIZE) ADDRESS, /* VALUES STAC K/ 
VARC (108) BITZ, /*TEMP CHAR STORE*/ 
IDSSTACK (20) ADDRESS, 
IDSPTR PITE, 
MAXSBYTE BASED MAXSINTSMEM BYTE, 
SUB$IND BYTE INITIAL (Ø), 
CONDSTYPS BYTE, 
HOLDSSECTION ADDRESS, 
HOLDSSECSADDR ADDRESS, 
SECTIONSFLAG BYTE INITIAL (9), 
LSADDR ADDRESS, 
DISPLAYSFLAG BYTE INITIAL (FALS?), 
LSLENGTH ADDRESS, 
LSTYPE BITE. 
LSDEC ENTE, 
CONSLENGTH BYTE, 
COMPILING BYTE INITIAL(TRUE), 


SP ӘНЕ INITIAL (255), 

MP БҮТЕ, 

МРР1 BYTE, 

NOLOOK BYTE INITIFAL(FALSE), 

NE J,K) BYTE, /*INDICIES FOR THE PARSTR*/ 
STATE Sec o INI TEAL(STARTS), 


/* * * * жожо ж ж CODE LITERALS * Ж ож ж ож x x x x x) 

/* TEE CODE LITERALS ARE BROKEN INTO GROUPS DEPENDING 
ON THE TOTAL LENGTH OF CODE PRODUCED FOR THAT ACTION */ 
С LzNGTH ONE */ 


4 


oD LIT “1 , /* ADD REGISTER 1 TO REGISTER 9 */ 

mee Lit 2, /* SUBTRACT REGISTER 1 FROM REGISTER Ø */ 
ШТІ? 5, /* MULTIPLY REGISTER 9 BY REGISTER 1 */ 
ШОТТ 4 , /* DIVIDE REGISTER @ BY REGISTER 1 


(NO REMAINDER) */ 

NEG LIT 757, /* NOT OPERATOR */ 
STP LIT “6%, /* STOP PROGRAM */ 
ЖЕГІП 779 /* STORE REGISTER 2 INTO REGISTER g */ 

/* LENGTH TWO */ 
AND LIT 8°, /% ROUND CONTENTS OF REGISTER 2 */ 

/* LENGTH THREE */ 
RET LIT 9°, /* RETURN */ 
ШЕ ГІТ 19 , /* CLOSE */ 
SER LIT °11°, /* BRANCH ON SIZE ERROR */ 
BRN LIT “12, /* BRANCH */ 
OPN LIT “13%, /* OPEN A FILE FOR INPUT */ 
ШЕГІП 7147, /< OPEN A FILE FOR OUTPUT */ 
OP2 LIT °15°, /* OPEN A FILE FOR BOTH INPUT AND OUTPUT */ 
ПИТЕР 16 , /* REGISTER GABATER TEAN */ 
ПИТ i? . /* REGISTER LESS THAN */ 
ПИТ 18°, /* REGISTER EQUAL */ 
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INV LIT “19%, /*“BRANCH IF INVALID-PILE-ACTION FLAG TRUE*/ 


HOR LIT 20, 


/* 


BRANCH ON END-OF-RECORDS FLAGS */ 


/* LENGTH FOUR */ 


ACC LIT 


Dl 


/* 


ACCEPT */ 


EEEEEDIT O22 ., /* STOP WITH DISPLAY */ 


МТ 25, 


/* 


LOAD A CODE ADDRESS DIRECT */ 


/* LENGTH FIVE */ 


DISPLAY */ 

DECREMENT COUNT AND BRANCH IF ZERO */ 
STORE NUMERIC */ 

STOKE SIGNED NUMERIC LEADING */ 

STORE SIGNED NUMERIC TRAILING */ 
STORE SEPARATE SIGN LEADING #/ 

STORE SEPARATE SIGN TRAILING #/ 

STORE A PACKED NUMERIC FIELD */ 

xs 


LOAD 
LOAD 
LOAD 
LOAD 
LOAD 
LOAD 
LOAD 


NUMERIC LITERAL #/ 

NUMERIC */ 

SIGNED NUMERIC LEADING */ 
SIGNED NUMERIC TRAILING */ 
SEPARATE SIGN LEADING Ж/ 
SEPARATE SIGN TRAILING */ 
4 PACKED NUMERIC FIELD */ 


PERFORM */ 

COMPARE NUMERIC UNSIGNED */ 

COMPARE NUMERIC SIGNED */ 

COMPARE ALPHABETIC */ 

REWRITE SEQUENTIAL */ 

DELETE SEQUENTIAL #/ 

ESAD A SEQUENTIAL FILZ =/ 

WRITE A RECORD TO A SEQUENTIAL FILE */ 
READ A VARIABLE LENGTH FILE */ 

WRITE A VARIABLE LENGTH RECORD */ 


CALCULATE A SUESCRIPT */ 
STRING GREATER TEAN */ 


STRING LESS THAN */ 
STRING EQUAL */ 
MOVE */ 

ж/ 


READ RELATIVE SEQUENTIAL */ 
WRITE RELATIVE SEQUENTIAL */ 
READ RELATIVE RANDOM */ 
WRITE RELATIVE RANDOM */ 
REWRITE RELATIVE */ 


DIS LIT 724”, /% 
mec LIT 0257, /% 
STO LIT “26°, /* 
SIT “27°, /* 
ОШО LIT “28°, /* 
ШЕГІП 20, /х% 
TALIT 30°, /* 
БИШЕ БІТ 31°, /* 
/* LENGTH SIX 
LOD LIT 327, /* 
Imi GIT 35°, /* 
то LIT “54 , /* 
Ше LIT “35°, /* 
NUS LIT 36^, /* 
Пет ^37 , /* 
EDO LIT 58“, /* 
/* LENGTH SEVEN #/ 
PER LIT °39°, /* 
CHU LIT 40 , /* 
ЕНЕ ГІТ “41°, /* 
БЕП ТІТ 42 . /* 
RWS LIT °43°, /* 
DES LIT 447, /* 
RDF LIT °45°, /* 
moe LIT 46°, /* 
NL LIT 47°, /* 
WVL LIT “аа”, /* 
/* LENGTH NINE */ 
БЕН LIT “49°, /* 
ST LIT 50 , /* 
Sar bit 51", /* 
Ewe LIT “52°, /* 
MOV LIT “53”, /* 
/* LENGTH TEN 
RRS LIT 7547, /* 
WRS LIT °55°, /* 
ВРА ІІТ 7567, /* 
WRR LIT 7577, /* 
RWR LIT “58, /* 
DLR LIT 7507, /* 


DELETE RELATIVE */ 


/* LENGTH ELSVEN */ 


MED LIT 


60°, 


/*MOVE INTO AN ALPHANUMERIC EDITED FIZLD™/ 


MNE LIT “61, /* MOVE INTO A NUMERIC EDITED FIELD */ 
/* VARIABLE LENGTE */ 

ӘШІР ГІП Ge , /* GO TO - DEPENDING ON */ 
/* BUILD DIRECTING ONLY */ 


Пт 65, 


бс 


INITIALIZE MEMORY */ 


evo 








Bot LIT 64 , /* BACK STUFF */ 
TER LIT 65°, /* TERMINATE BUILD #/ 
Перт 66 ; /* START CODE */ 
/* * ж ж PARSER ROUTINES * * * * */ 
DIGIT: PROCEDURE (CHAR) BYTE; 
DECLARE CHAR BYTE; 
RETURN (CHAR<="9°) AND (CHAR>="9"); 
END DIGIT; 
LETTER: PROCEDURE (CEAR) BYTE; 
DECLARE CHAR BYTS; 
RETURN (CHARD="A’) AND (CHAR<="2“); 
END LETTER; 
INVALIDSTYPE: PROCEDURE; 
CALL PPINTSSRROR( “IT” )3 
END INVALIDSTYPE; 
3YTESOUT: PROCEDURE(ONESBYTZ); 
DECLARE ONESBITE BYTE; 
E (OUTPUTSPTR:=OUTPUTSPTR + 1) > OUTPUTS END THEN 
DO; 
CALL WRITESOUTPUT( .OUTPUTSBUPT); 
OUTPUTS PTR=.OUTPUTSBUFS; 
END; 
OUTPUTSCHAR=ONESBYTE; 
END BYTESOUT; 
ADDRSOUT: PROCEDURE (ADDR); 
DECLARE ADDR ADDRESS; 
CALL BYTESOUT(LOW(ADDR)); 
CALL BYTESOUT(HIGH (ADDR) ); 
END ADDRSOUT; 
INCSCOUNT: PROCEDURE(CNT); 
DECLARE CNT BYTE; 
IF(NEXTSAVAILABLE:sNEXTSAVAILABLE + CNT) 
>MAXSINTSMEM TEEN CALL FATALSERROR( MO”); 
END INCSCOUNT; 
ONSSADDRSOPP: PROCZDURE(CODE, ADDR); 
DECLARE CODE BYTE, ADDR ADDRESS; 
TAL Geo La SOUT( CODE); 
CALL ADDPSOUT(ADDR); 
ПОШИ LNGSCOUNT (3); 
END ONESADDRSOPP; 
NOTSIMPLIMENTED: PROCEDURE; 
CALL PRINT$SERROR (’NL’); 
END NOTSIMPLIMEZNTED; 
MATCH: PROCEDURE ADDRESS; 
/* CHECKS AN IDENTIFIER TO SEE IF IT IS IN THE SYMBOL 
TABLE. IF IT IS PRESENT, CURSSYM IS SET FOR ACCESS, 
OTHERWISE THE POINTERS ARE SET FOR ENTRY*/ 
DECLARE POINT ADDRESS, COLLISION BASED POINT ADDRESS, 
(HOLD,I) BYTE; 
IF VARC(@)>MAXSIDSLEN THEN VARC(@)=MAXSIDSLEN; 
HOLD=@; 
DO ЕТО УАЗС(0); 
HOLD=HOLD+VARC(I); 
END; 
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POINT=HASHSTAESADDR + SHL((HOLD AND HASHSMASK),1)3 
DO FOREVER; 
IF COLLISION=@ THEN 
DO; 
CUR$SYM,COLLISION=NEXT$SYM; 
CALL BUILDSSYMBOL(TARC(O)); 
SYMROL(PSLENGTE)=VARC(Z); 
DO I=1 TO VARC(2); 
SYMBOL(STARTSNAME+I )=VARC(I); 
END; 
CALL SETSTYPE(UNRESOLVED); /* UNRESOLVED LABEL */ 
RETURN CURSSYM; 
END; 
ELSE 
DO; 
CURSSYM=COLLISION; 
IF (HCLD:=GETSPSLENGTH)=VA2C(@) TEEN 
DO; 
Dn 
DO WHILE SYMBOL(STARTSNAME + І)= VARC(I); 
IF (I:=I+1)>HOLD THEN RETURN(CURSSYM:=COLLISION); 
END; 
END; 
END; 
POINT=COLLISION; 
END} 

END MATCH; 

SETSVALUE: PROCEDURE(NUMB); 
DECLARE NUMB ADDRESS} 
V3LUE(MP)=NUMB;5 

END SETSVALUE; 

SETSVALUE2: PRCCEDURE(ADDR); 
DECLARE ADDR ADDRESS; 
VALUE2(MP)=ADDR; 

END SETSVALUE2; 

SUBSCNT: PROCEDURE BYTE; 

IF (SUBSIND:=SUBSIND + 1)>8 THEN 
SUBSIND=1 $3 
RETURN SUBSIND; 

END SUBSCNT; 

SODES BYTE: PROCEDURE (CODE); 
DECLARE CODE BYTE; 

CALL EYTESOUT(CODE); 
CALL INCSCOUNT (1); 

END CODESBYTE; 

CODESADDRESS: PROCEDURE (CODE); 
DECLARE CODE ADDRESS; 

CALL ADDRSOUT(CODE); 
CATT INCSCOUNT (2) > 

END CODESADDRESS; 

INPUTSNUMERIC: PROCEDURE BYTE; 
ПОСТЕ TO VARC(G); 

ПЕ ЦОТ БІСІТ(ТАВС(СТВ)) ТНЕМ RETURN FALSE; 
END} 
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ВЕТЈЕМ ТЕЏЕ; 
END INPUTSNUMERIC; 
CONVERTSINTEGER: PROCEDURE ADDRESS; 
ACTR=9; 
DOCTR- TO VARC(D); 
IF NOT DIGIT(VARC(CTR)) THEN CALL PRINTSERROR(' ANN 
ASCTR=SHL(ACTR,3)+SHL(ACTR,1) + VARC(CTR) - 70”; 
END; 
RETURN АСТЕ; 
END CONVERTSINTEGER; 
BACKSTUFF: PROCEDURE (ADD1,ADD2); 
DFCLARE (ADD1,ADD2) ADDRESS; 
AE Y TESOUT(BST); 
CALL ADDR$OUT(ADD1); 
CALL ADDRSOUT(ADD2); 
END 3ACKSSTUFF; 
UNRESOLVEDSBRANCH: PROCEDURE; 
CALL SETSVALUE(NEXTSAVAILABLE + 1); 
CALL ONESADDRSOPP(B3RN,2); 
certs VALUS2(NERTSAVAILABLE); 

ND UNRESOLVED$S3RANCH; 

BACKSCOND: PROCEDURE; 

CALL BACKSTUFF(VALUE(SP-1),NEXTSAVAILABLE); 

END BACKSCOND; 

SETSBRANCH: PROCEDURE; 

Shes STSVALUR(NYXTSAVALLABLS) 3 
CALL CODESADDRESS(0); 
END SETSBRANCH; 
KEEPSVALUES: PROCEDURE; 
CNFEL S*TSUVALUE(WELUE(SP)); 
CRIL SETSVWALUE2(VALUE2(SP)); 

END KEEPSVALUES; 

SETSRECSADDRESS: PROCEDURE(RECORDSADDR) ADDRESS; 
DECLARE (RECORDSADDR, HOLD$SADDR) ADDRESS; 
CURSSYM=RECORDSADDR; 

HOLDSADDR=GETSADDRESS; 
CURSSYM=GETSFCBSADDR; 
RETURN HOLDSADDR; 

END GETSRECSADDRESS; 

GETSRECSLEN: PROCEDURE( RECORDSADDR) ADDRESS; 
DECLARS (RECCRDSADDR, HOLDSLENGTH) ADDRESS; 
CURSSYM=RECORDSADDR; 
HOLDSLENGTH=GETSLENGTH; 

CURSSYM=GETS FCBSADDR; 
RETURN ECLDSLENGTH; 
END GETSRECSLEN; 
STDSATTRIRUTES: PROCEDURE( TYPE); 
DECLARE LY See BYTE; 
CALL CODESADDEESS(GETSFCBSADDE)5 
CALL CODESADDRESS(GETSRECSADDRESS(GETSADDRESS)); 
CALL COPESADDRESS(GETSRECSLEN(GETSADDPa3ZSS)); 
(m TYPH=0 THEN RETURN? 
CURSSYM=SYMBOLSADDR(RELSID); 
CALL CODPZSADDRESS(GETSADDRESS); 
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CALL CODESBYTE(CETSLENGTH); 
END STDSATTRIBUTES; 
WRITESASRECORD: PROCEDURE; 

IF GETSLEVEL<>1 THEN CALL PRINTSERROR( “WL'); 

ELSE DO; 

CUR$SYM=GETSFCBSADDR; 
M CT: =CETSTYPE)=1 THEN 
DO; 
CALL CODESBYTE(WTF) 5 
CALL STDSATTRIBUTES(2); 
END; 
>: IF CTR=2 THEN 
, 
CALL CODE$BYTE(WRS); 
CALL STDSATTRIBUTES(1); 
END; 
ELSE IF CTR=3 THEN 
DO; 
Come CONESBYTHGWRR) ; 
CALL STDSATTRIBUTES (1); 
END; 
ELSE IF CTR=4 THEN 
DO; 
CALL CODESEITE(WTL); 
CALL STDSATTRIBUTES(@); 
END; 
ELSE CALL FRINTSERROR(/FT/); 

END; 

END WRITESASRECORD; 
READSASFILE: PROCEDURE; 

NOAA: =GETSTYPR)=1. THEN 

DO; 

КҮШІ; CODESBYTE(RDF); 
CALL STDSATTRIBUTES (2); 

END; 

ELSE IF CTR=2 THEN 

DO; 

GAL CODESBYTI(RAEAS); 
OS EOS ATTRIBUTES(1)5 

END; 

ELSE IF CTR=3 TEZN 

DO; 

CALL CODESBITE(RRR) 5 
CALL STDSATTRIBUTES (1); 

END; 

ELSE IF CTR=4 THEN 

DO; 

CALL CODESBIYTE(RVL); 
CALL STDSATTRIBUTES(@); 

END; 

LSE CALL 22 INTSERROR( FT’); 
END READSASFILE; 
ARITHMETICSTYP®: PROCEDURE BYTE; 

IF ((LSTYPB: =ANDSOUTSOCCURS(LSTYPE) ) D>=NUMERICSLITERAL) 
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AND (LSTYPE<=COMP) THEN RETURN LSTYPE - NUMERICSLITERAL; 

CALL INVALIDSTYPE; 

RETURN 0; 

END ARITEMETICSTYPE; 
DELETESASFILE: PROCEDURE; 

М MORE GETSTYEPR)=3 THEN 

© 
CALL CODESBYTE(DLR); 
CALL STDSATTRIBUTES (1); 

END; 

ELSE IF CTR=2 THEN 

DO; 

CALL CODESBYTE(DLS); 
CALL STDSATTRIBUTES (9); 

END; 

Pome iLL PRINTSERROR(^IT^); 
END DELETESASFILE; 
REWRITESASRECORD: PROCEDURE; 

IF GETSLEVEL<>1 THEN CALL PRINTSERROR( WL’); 

ELSE DO; 

CURSSYM=GETSFCBSADDR3 
IF (CTR:=GETSTYPE)=3 THEN 
DOS 
CALL CODESBYTTE(RWR); 
CALL STDSATTRIBUTES(1); 
END; 
ELSE IF CTR=2 THEN 
DO; 
CALL CODESBYTE(EWS); 
GALL SEDSUTTRIBUTES (0); 
END; 
ELS? CALL PRINTSZRROR('/IT/^); 

END; 

END REWRITESASRECORD; 
ATTRIBUTES: PROCEDURE; 

BNEREOCHESEWDRUSS(LSADDR); 

CALL CODESBYTE(LSŠLENGTE); 

GALL CODESBYTE(LSDEC); 

IND ATTRIBUTES; 
LOADSLSID: PROCEDURE(SSPTR); 

DECLARE SSPTR BYTE; 

IF ((ASCTR := VALUE(SSPTR)) <= NONSNUMERICSLIT) OR 

(ACTR = NUMERICSLITERAL) THEN 

DOS 

LŠADDR=VALUE2(S?TR); 
LSLENGTE=CONSLENGTH; 
LSTYPE=ASCTR; 
RETURN; 

END; 

IF ASCTR<=LITSZERO THEN 

DO; 

SUERO TS ADDR=ASCTR; 
Eo LeNGTH=1; 
RETURN; 





END; 
CURSSYM=VALUE(SSPTR); 
LSTYPE=GETSTYPE; 
LSLENGTE=GETSLENGTH; 
L$DEC-GETSDECIMAL; 
IF(LSADDR:=VALUE2(SSPTR))=0 THEN LSADDR=GETSADDRESS; 
END LOADSLSID; 
LOADSREG: PROCEDURE(REGSNO,PTR); 
DECLARE (REGSNO,PTR) BYTE; 
CALL LOADSLSID(PTR); 
CALL CODESBYTE(LOD+ARITEMETICSTYPE); 
CALL ATTRIBUTES; 
CALL CODESBYTE(REGSNO); 
END LOADSREG; 
STORESREG: PROCEDUREZ(PTR); 
DECLARE PTR BYTE; 
ENDE LOADSLSID(PTR); 
CALL CODESBYTE(STO + ARITEMETICSTYPE -1); 
CALL ATTRIBUTES; 
END STORESZEG; 
STCRESCONSTANT: PROCEDURE ADDEESS; 
IF(MAXSINTSMEM:=MAXSINTSMEM – VARC(Q))<NEXTSAVAILABLE 
THEN CALL FATALSERROR( мо“); 
ШЕРІ BYTESOUT( INT); 
CALL ADDRSOUT(MAXSINTSMEM); 
CALL ADDRSOUT(CONSLENGTE:2742C(0)); 
 ИСОТЕ - 1 PO CONSLENGTE; 
CALL BYTESOUT(VARC(CTR)); 
END; 
RETURN MAXSINTSMEM; 
END STORESCONSTANT; 
NUMERICSLIT: p BYTE; 
DECLARE CHAR РҮТЕ 


DO CTR=1 ТО VARC(O); 
IF NOT( DIGIT(CHAR:=VARC(CTR)) 
OR (CHAR= Ev OR (CHAR="+") 
OR (CEAR=". )) THEN RETURN FALSE; 


END; 
RETURN TRUE; 
END NUMERICSLIT; 
ALPHASLIT: PROCEDURE BYTE; 
DO CTR=1 TO VARC(O); 
IF NOT(LETTER(VARC(CTR))) THEN RETURN FALSE; 
END; 
RETURN TRUE; 
END ALPEASLIT; 
ROUNDSSTORE: PROCEDURE; 
E. VALUE(SP)<>@ THEN 
0, 
CALL CODESBYTE(RND); 
CALL CODESPYTE(LSDEC); 
END; 
CALL STORESREC(SP-1); 
END ROUNDSSTORE; 
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ADDSSUB: PROCEDURE (INDEX); 
DECLARE INDEX BYTE; 
CALL LOADSREG(@,MPP1); 
IF VALUE(SP-3)<>2 THEN 
DO; 
CALL B рур) 
CALL CODESBYTE(ADD); 
CALL CODESBITE(STI); 
END; 
CALL LOADSREG(1,SP-1); 
CALL CODESBYTE(ADD * INDEX); 
CALL ROUNDSSTORS; 
END ADDSSUB; 
MULTSDIV: PROCETURE(INDEX); 
DECLARE INDEX BYTE; 
CALL LOADSREG(@,MPP1); 
CALL LOADSREG(1,SP-1); 
CALL CODESBYTE(MUL * INDEX); 
CALL ROUNDSSTORE; 
BND MULTSDIV; 
CHECKSSUBSCRIPT: PROCEDURE} 
CURSSYM=VALUE(MP);3 
IF GETSTYPE<MULTSOCCURS THEN 
DO; 
Cae ePRINTSEPROR( IS’); 
RETURN} 
END; 
IF INPUTSNUMERIC THEN 
DO; 
CALL SETSVALUEZ2(GETSADDRESS + (GETSLENGTE * 
CONVERTSINTEGER)); 
RETURN; 
END; 
CURSSYM=MATCH; 
IF ((CTR:=GETSTYPE)<NUMERIC) OR (CTRD>COMP) THEN 
CALL PRINTSERROR( ‘TE’ ); 
CALL ONESADDRSOPP(SCR,GETSADDRESS); 
САР CONS EYTE(SUBSCNT); 
РАТЕ СОБЕБВУТЕ(СЕТ5УРЕМСТЕ); 
CALL SETSVALUE2(SUBSIND); 
END CHZCKSSUBSCRIPT; 
LOADSLABEL: PROCEDURE; 
CURSSYM=VALUE(MP); 
IF (ASCTR:=GETSADDRESS)<>2 TEEN 
AA CSS IU PFCASCTR, VALUEZ2(MP)); 
CALL SETSADDRESS(VALUEZ(MP)); 
NESST E LABELSTYPR); 
IF (ASCTR:=GETSFCBSADDR)<>@ THEN 
CALL BACKSSTUFF(ASCTR,NEXTSAVAILARLE); 
SYMBOLSADDR(FCRSADDR)=NEXTSAVAILABLE; 
CALL ONESADDESOPP(RET,0); 
END LOADSLABEL; 
LOADSSECSLABEL: PROCEDURE; 
ASCTR=VALUS(MP); 
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CALL SETSVALUE(EOLDSSECTION); 
HOLDSS ECTION=ASCTR;} 
ASCTR=VALUE2(MP); 
CALL SETSVALUE2(HOLDSSECSADDR); 
HOLDSSECSADDR = ASCTR; 
CALL LOAD$LABEL; 
END LOADSSECSLA4BEL; 
LABELSADDRSOFFSET: PROCEDURE (ADDR, HOLD, OFFSET) ADDRESS; 
DECLARE ADDR ADDRESS; 
DECLARE (HOLD, OFFSET, CTR) BYTE; 
CURSSYM=ADDR; 
ЖЕМ TIRE T=LABEDS TTPE THEN 
Dos 
IF HOLD THEN RETURN GETSADDRESS; 
RETURN GETSFCBSADDR;3 
END; 
IF CTR<>UNRESOLVED THEN CALL INVALIDSTY?3; 
IF HOLD THEN 
DO; 
ASCTRSGETSADDEESS; 
CALL SETSADDRESS(NEXTSAVAILABLE + OFFSET); 
RETURN ASCTR; 
END; 
ASCTR=CETSFCBSADDR; 
SYMBOLSADDR(FCBSADDR)=NEXTSAVAILABLE + OFFSET; 
RETURN ASCTR; 
END LABELSADDR$CFFSET; 
LABELSADDR: PROCEDURE (ADDR, HOLD) ADDRESS; 
DECLARE ADDR ADDRESS, 
HOLD BYTE; 
RETUEN LABELSADDRSOFFSET (ADDR, HOLD, 1); 
END LABELSADDR; 
CODESFORSDISPLAY: PROCEDURE (POINT); 
DECLARE POINT BYTE; 
CALL LOADSLSID( POINT); 
CALL ONESADDRSOPP(DIS,L$ADDR); 
ENEDEOODESBYUBKTLSLENGTE); 
IF DISPLAYSFLAG THEN CALL CODESBYTE (1); 
ELSE CALL COTESBYTE(9); 
DISPLAYSFLAG=FALSS; 
END CODESFORSDISPLAY; 
ASANSTYPE: PROCEDURE BYTE; 
RETURN (LSTYPE=ALPHA) OR (LSTYPE=ALPHASNUM) $ 
END ASANSTY PE; 
NOTSINTEGER: PROCEDURE BYTE; 
PETURN L$SDEC<>2; 
END NOTSINTEGER; 
NUMERICSTYPE: PROCEDURE BYTE; 
EPU NAIL TYPE>=NUMERICSLITEPRAL) AND (LSTYPE<=COMP); 
END NUMERICSTYPE; 
GENSCOMPARE: PRCCEDURE; 
DECLARE (HSTYPE,HSDEC) BYTE, 
(HSADDR,HSLENGTH) ADDRESS; 
CALL LOADSLSID(MP); 
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STA =ANDSOUTSOCCURS(LSTYPE)> 
IF CONDSTYPE=3 THEN /* COMPARE FOR NUMELIC #/ 
DO; 
IF ASANSTYPE OR (LSTYPEDCOMP) THEN CALL INVALIDSTYPE; 
CALL SETSVALUEZ(NEXTSAVAILABLE); 
IF LSTYPE=NUMERIC THEN CALL CODESBYTE(CNU); 
BLSE CALL CODESRYTE(CNS); 
CALL CODESADDRESS(LSADDR); 
CALL CODESADDRESS( LSLENGTH) ; 
CALL SETS BRANCH} 

END; 
ELSE 
DO; 

IF NUMERICSTYPE THEN CALL INVALIDSTY?3; 
CALL SETSVALUE2(NEXTSAVAILABLE); 
СОЕ ЗТ (ват ): 
CALL CODESADDRESS(LSADDR); 
CALL CODESADDRESS(LSLENGTE) ; 
CALL SETS BRANCH; 
PND; 
ELSE DO; 
IF NUMERICSTYPE THEN CTR=15 
ELSE CTR=8; 
= 
HSDEC=LSD&C} 
HSADDR=LS ADDR} 
ESLENGTH=LSLENGTA; 
CALL LOADSLSID(SP) $ 
I? NUMERICSTYPE THEN CTE=CTR+1;3 
CTR=2 THEN /* NUMERIC COMPARE */ 
or 


IF CONDSTYPE=4 THEN 


EN 


CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
р; 


LOADSREG(0,MP); 
SETSVALUE2(NEXTSAVAILABLE-6); 
LONDSREG(1,SP); 
CODESBYTE(SUB); 

CODESBYTE(RGT + CONDSTYPE); 
SETSBRANCA; 


ELSE DO; 
/* ALPHA NUMERIC COMPARE */ 
IF (HSDEC<>8) OR (HSTYPE=COMP) 


OR (ISDEC<>Q) 


OR (LSTYPE=COMP) 


OR (HSLENGTH<>LSLENGTHE) TEEN CALL INVALIDSIYPE; 


CALL 
CALL 
CALL 
CALL 
CALL 
CALL 


END; 


END; 


DECLARS 


SETSVALUEZ(NEXTSAVAILARLE); 
CODESBYTE(SGT+CONDSTYPS); 
CODESADDRESS(ESADDR); 
CODESADDRESS(LSADDR); 
CODESADDRESS(HSLENGTH); 
SETSBRANCE; 


END GENSCOMPARE; 


MOVES TYPE: PROCEDURE BYTE; 


c dum 





AUD PIPE РУТЕ, 
ALPHASNUMSMOVE DET OC. 


ASNSEDSMOVE I. 
NUMERICSMOVE LIT ^2^, 
NSEDSMOVE LIT 35; 


LSTYPE=ANDSOUTSOCCURS (LSTYPE); 
IF( (HOLDSTYP®:=ANDSOUTSOCCURS(GETSTYPE) )=GROUP) OR 
(LSTYPE=GRCUP) 
THEN RETURN ALPHASNUMSMOVE; 
IF HOLDSTYPE=ALPHA THEN 
IF ASANSTYPE OR (LSTYPE=ASED) OR (LSTYPE=ASNSED) 
OR ((ALPEASLITSFLAG) AND (LSTYPE = NONSNUMERICSLIT) ) 
THEN RETURN ALPHASNUMSMOVS; 
IF HOLDSTYPR=ALPHASNUM THEN 
Oy 
IF NOTSINTEGER THEN CALL INVALIDSTYPE; 
RETURN ALPHASNUMSMOVE; 
END; 
IF (HOLDSTYPE>=NUMERIC) AND (HOLDSTYPE<=COMP) THEN 
00; 
ТЕЁ (Т5ТҮРЕ=А1ТРНА) ОВ (1$ТҮРБ>СОМР) ТНЕМ 
БАЙЫР ІГИГАТІТПӘТІРЕ; 
RETURN NUMERICSMOVE; 
END; 
IF HOLDSTYPE=ASNSED THEN 
DO; 
IF NOTSINTEGER TEEN CALL INVALIDSTYPE; 
RETURN ASNSEDSMOVE; 
END; 
IP HOLDSTYPE=ASED THEN 
IF ASANSTYPE OR (LSTYPEDCOMP) OR (LSTYPE 
= NONSNUMERICSLIT) 
THEN RETURN ASNSEDSMOVS; 
IF ROLDSTYPE=NUMSED THEN 
IF NUMEPICSTYPE OR (LSTYPE=ALPRASNUM) THEN 
RETURN NSED$SMOTE; 
CALL INVALIDSTYPE; 
RETURN 0; 
' END MOVESTYPE; 
GENSMOVE:PROCEDURE; 
DECLARE 
LENGTH1 ADDRESS, 
ADDR1 ADDRESS, 
EXTRA ADDRESS; 
ADDSADDSLEN: PROCEDURE; 
CALL CODESADDRESS(ADDR1); 
CALL CODESADDREZSS(LSADDR); 
CALL CODESADDRESS(LSLENGTE); 
END ADDSADDS LEN; 
CODESFORSEDIT: PROCEDURE; 
CALL ADDSADDSLEN; 
CALL CODESADDRESS(GETSFCBSADD2); 
CALL CODESADDRESS(LENGTE1); 
END CODESFORSEDIT; 


216 





CALL LOADSLSTD(MPP1); 

CURSSYM=VALUEF(SP); 

IF (ADDR1:-VALUE2(SP))-0 THEN ADDR1-GET$SADDRESS; 
INNGTHISGETSLENGTE; 

DO CASE MOVESTYPS; 


/* ALPHA NUMERIC MOVE */ 


DO; 
IF LENGTHI>LSLENGTH THEN EXTRA=LENGTH1-LSLENGTH; 
I SEND 
ЕХТВА-0; 
L$ LENG TH=LENGTH1; 
END; 
BELLZSCODESBITELMOT); 
CALL ADDSADDSLEN; 
CALL CODESADDRESS(EXTRA); 
END; 
/* ALPHA NUMERIC EDITED */ 
DO; 
CALL CODESBYTE(MED); 
CALL CODESFORSEDIT; 
END; 
/* NUMERIC MOVE */ 
DO; 


, 
CALL LOADSREG(2,MPP1); 
CALL STORESREG(SP); 
END; 
/* NUMERIC EDITED MOVE */ 


DO; 
BSRLELODESBITE(MNE); 
Cale Coles PORSEDITS 
CALE CODESBYTE(LSDEC) 3 
СОА СОрЕЗЭВІТЕ(СоФӘТЕСІМАТ); 
END; 
END} 
END GENSMOVE; 
CODESGEN: PROCEDURE( PRODUCTION); 
DECLARE PRODUCTION BYTE; 
IF PRINTSPROD THEN 
DO; 
САЛЕ ОСЕТЕ: 
CALL PRINTCFAR( POUND); | 
CALL PRINTSNUMBER( PRODUCTION) } 
END; 
DO CASE PRODUCTION; 
A PRODUCTIONS */ 
/* CASE @ NOT USED */ 


, 
/ 1 <P-DIVD> ::= PROCEDURE DIVISION «USING? 
NEUN / 
00; 
COMPILING = FALSE; 


с 








IF SECTIONSFLAG THEN CALL LOADSSECSLABEL$ 
END; 


е 2 <USING>D ::= USING <ID-STRING> Ф/ 
CALL NOTSIMPLIMENTED; /* INTER PROG COMM */ 
/* 5 X! <EMPTY> ж/ 
>; /* NO ACTICN REQUIRED */ 
+ 4 <ID-STRING> ::= <ID> T7 
IDSSTACK(IDSPTR:=@)=VALUE(SP); 
Ды 5 NI <ID-STRING> <CID> ж 
DO; 
IF(IDSPTR:=IDPTR+1)=20 THEN 
DO; 


CALL PRINTSERROR( “ID’); 
IDSPTR=193 
END; 
ME Upon Cm 
END; 
/* 6 <PROC-BODY> ::- <РАВАСНАРНУ Sey 
; /* NO ACTION REQUIRED */ 
pos 7 \! <PROC-BODY> <PARAGRAPH> 5/ 
; /* NO ACTION REQUIRED */ 
/* 8 <PARAGRAPH> :3:= <ID> . <SENTENCE-LIST> у 
ШО; 
IF SECTIONSFLAG=@ THEN SECTIONSFLAG=2;3 
CALL LOADSLABEL; 


END; 
ur 9 Nici D> SECTION & ж/ 
DO; 
IF SECTIONSFLAG<>1 THEN 
DO} 
ПИО ош PONGrRSG=2 THEN CALL PRINTSERROR( PE”); 
SO TIONSELAG=1; 
HOLDSSECTION=VALUE(MP); 
EOLDSSECSADDRSTALUE2(MP); 
END; 
Р p CALL LOADSSECSLABEL; 
ND; 
s 10 <SENTENCE-LISTD ::= <SENTENCED . ж/ 
5 /* NO ACTICN REQUIRED */ 
pos 11 \! CSENTENCE-LIST? «SENTENCE» . А 
; /* NO ACTICN RYQUIRED */ 
ды 12 <SENTENCED ::= CIMPERATIVE> * 
; /* NO ACTION REQUIRED */ 
/* 13 \! «CONDITIONAL» = / 
› /* NO ACTICN REQUIRED */ 
КЕТА \! ENTER <ID> <OPT-ID> ж/ 
CALL NOTSIMPLIMENTED; /* LANGUAGE CHANGE */ 
E. 15 «IMPERATIVE» ::- ACCEPT «SUBID» ж/ 
, 


CALL LOADSLSID(SP); 
CALL ONESADDRSOPP(ACC,L$ADDR); 
CALL CODESRYTE (LSLENGTH ); 
END; 
у 16 NV! <ARITHMETICD * / 


cp 





; /* NO ACTION REQUIRED */ 
Ма 1? ӘЗЕР Трн СУ */ 
CALL NOTSIMPLIMENTED; /* INTER PROG COMM */ 
/* 18 XI CLOSE <ID> И 
DO; 
DECLARE TYPE BYTE; 
TY PE=GETSTYPE; 
IF (TYPE>@) AND (TYPE<5) THEN 
CALL ONES ADDRSOPP(CLS,GETSFCBSADDR); 
ELSE CALL PRINTSERROR( ‘CE’ )} 


END; 
pos 19 Nin E=ACT> x / 

; /* NO ACTION REQUIRED */ 
/* 20 BEEEDISPUDATGQEIT/IDO?SCOPT-LIT/ID» z7 
DO; 


CALL CODES FORSDISPLAY(MPP1); 

IF VALUE(SP)<>@ THEN 

ШО; 

DigeeayS FLAG=TRUE; 
CALL CODESFORSDISPLAY(SP); 

END; 
END; 
po^ 21 \! EXIT <PROGRAM-ID> $7 
; /* NO ACTION REQUIRED */ 
у“ 22 NO OD 2y 
CALL ONESADDRSOPP( BRN, LABELSADDR(VALUE(SP),1));} 
/* 2% \! GO <ID-STRING> DEPENDING <ID> њу 
DO; 
CALL CODESBYTE(GDP); 
CALL CODESBYTE(IDSPTP); 
CURSSYM=VALUE(SP); 
CALL CODESBYTE(GFTSLENGTH); 
CALL CODESADDRESS(GETSADDRESS); 
DO CTR=0 TO IDSPTR; 
CALL 
EMEN | os DR OPESETUEDSSTACECISSPER) 1,005 
END; 


END; 

/* 24 NI MOVE <LIT/ID> ТОССО: = У 
CALL GENSMOVE; 

/* 25 NMICOPENUCTYPR-ACTION» «ID» =, 
Du 


DECLARE TYPE BYTE; 
IMPE=CRTSTYDE; 
IF (TYPE-1 OR TYPZ-4) AND (VALUE(MPP1)<>2) 
THEN CALL ONESADDRSOPP(OPN+VALUE(MP91),GETSTCISADDR); 
ELSE 
Пи тувт=> ORI TYPE=3) TEEN 
CALL ONESADDRSOPP(OPN+VALUS(MPP1) ,GATSTCBSADER); 
ELSE CALL PRINTSERROR( “OE” )3 
END; 
/* 26 X1 PERFORM «ID? <TERU> <FINISH> ж/ 
DOS 
DECLARE (ADDP2,ADDR3) ADDRESS; 


er 





IF VALUE(SP-1)=0 

THEN ADDR2=LABELSADDRSOFFSET(VALUZ(MPP1),0,3); 

ELSE ADDR2=LABELSADDRSOFFSET(YALUE(SP-1),0,3); 

IF (ADDR3:=VALUE2(SP) )=9 THEN ADDR3= NEXTSAVAILABLE 
+ 75 

ELSE CALL BACKSTUFF(VALUR(SP),NEXTSAVAILABLE + 7); 

CALL ONESADDRSOPP(PER,LABELSADDR(YALUE(MPP1),1)); 

CALL CODESADDRESS(ADDR2); 

CALL CODES ADDRESS(ADDR3); 


END; 
ET 27 \! <READ-ID> t 

CALL NOTSIMPLIMENTED; /* GRAMMAR ERROR */ 

/* 28 \1 STOP <TERMINATE> N 

DO; 

IF VALUE(SP)=@ THEN CALL CODESBITET(STP); 
ELSE DO; 
CALLCNZSADDRSOPP(STD,VALUF2(SP)) 
CALLCODESBYTE(CONSLENGTH); 
END; 

END; 

E 20 <CONDITIONAL> ::= <ARITHMETICD <SIZE-ERROR> ж/ 
/* 29 <IMPERATI TED A 

CALL BACKSCOND; 

/* 3 \! <FILE-ACT> «INVALID? <IMPERATIVS> */ 
CALL BACKSCOND; 

yt 2i \l <IF-NONTERMINAL> <CONDITIOND 

<ACTION> ELSE */ 
/* on <IMPERATIVE> 2 
ро; 


CALL BACKSTUFF(VALUE(MPP1) ,VALUEZ(S?P-2) ); 
CALL BACKSTUFP(VALUE(SP-2) NEXTSAVAILABLE); 
END; 


/* 32 NY <READ-1D> <SPECIAL> CIMPERATIVE> */ 
CALL BACKSCOND; 
gs 33 <ARITHMETICD ::= ADD <L/ID> <OPT-L/ID> TO 
<SUBID> */ 
/* 33 <ROUND> en 
CALL ADD$SUB(2); 
/* 34 Seb JIDE <L/ID> INTO <SUBID> <ZOUND> 27 
CALL MULT$SDIV (1); 
/* 55 КІШТЕР <L/ID> 31 <SUBID> <ROUND> * / 
CALL MULTSDIV(@);3 
/* 56 \! SUBTRACT <L/ID> <OPT-L/ID> FROM и 
/* 56 <SUBID> <ROUND> * / 
BALL ADDSSUB(1); 
у ОИИБ ЕАС s= DELETE <ID> m 
CALL DELETESASPILE; 
/* 38 \1 REWRITE <ID> */ 
CALL REWRITESASRECORD; 
у 59 МЕТЕ CID» <SPECIAL=ACT */ 
CALL WRITESASRECORD; 
СЕЙ <CONDITIOND 2:= <LIT/ID> <NOT> <COND-TYP=> = 
DO; 


IF IFSFLAG THEN 
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DO; 
LESWLAGSNOT ISSFLAG; /* PRESET IF$FLAG */ 
CARE CODESBYTE(NEG); 
END; 
CALL GENSCOMPARE; 
END; 
+ 41 <COND-TYPE> ::= NUMERIC э 
CONDSTYPE=3; 
+ 42 \! ALPHABETIC у 
COND$STYPE=4; 
{ * 45 \! <COMPARE> <LIT/ID> Әз 
CALL KEEPSVALUES; 
/* 44 NOT? ::- NOT ж/ 
IF NOT IFSFLAG THEN 
CALL CODESBYITE(NEG); 
ELSE IFSFLAG=NOT IFSFLAG; /* RESET IFSFLAG */ 
Да 45 КІ <ҰЙРТТІ> = 
; /* NO ACTICN REQUIRED */ 


/* 46 <COMPARE> ::= GREATRES S 
ОМОТУ РЕ=И; 

/* 47 W LESS = 
CONDSTYPE=1; 

у“ 48 X! EQUAL */ 
COND$STYPE=2; 

pis: 49 <ROUND> ::= ROUNDED ж/ 
CAGE SSTSVALUE(1); 

y= 50 NI <®МРТҮ› * / 

DU * NO*NCTION R$ ZOUIRED ж / 

p E TERMINATE» ::= <LITERAL> * / 
; /* NO ACTION REQUIRED = 

/* 52 NX! RUN и 


; /* NO ACTION REQUIRED -— VALUZ(SP) ALREADY ZERO * 
/* e SPECIAL) %:- INVALID» = 
; /* NO ACTION REQUIRED */ 

/* 54 \! END x 

ро; 
(amis mrsv ALUE(2); 
CALL CODESBYTE( EOR) ; 
CALL SETS BRANCH} 


END; 
/* 58 <OPT-ID> ::= <SUBID> ay 
; /* VALUE AND VALUEZ ALREADY SET */ 
/ж 56 \! * 
5 /* VALUE ALREADY ZERO */ 
/* 57 CACTICND ::= <IMPERATIVED * / 
CALL UNRESOLVEDSBRANCH; 
/* ба X1 NEXT SENTENCE ж/ 
CALL UNRESCLV EDS BRANCH; 
ЖЕ 59 TERU? ::2 THRU <ID> = / 
CALL KEEPSVALUES; 
/* 62 \! ж/ 
5 /* NO ACTION REQUIRED */ 
/* 61 <FINISH> ::= <L/ID> TIMES ж/ 
DO; 
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GALD LOADS LSID (MB); 

CALL ONESADDPSOPP(LDI,LSADD?); 

CALL CODESBYTE(LSLENGTE); 

CALL SETSVALUE2(NEXTSAVAILABLE); 

CALL ONESADDRSOPP(DEC,0); 

CALL SETSVALUE(NEXTSAVAILABLZ); 
CALLCODESADDRESS(9); ҰМ; 


/* 62 \! UNTIL «CONDITION» СА 
CALL KEEPSVALUES; 
/* 63 M ж/ 
; /* NO ACTION REQUIRED */ 
+ 64 <INVALID> ::= INVALID 2 
О; 


CALL SETSVALUE(1); 
CALL CODESBYTE( INV); 
CALL SETSBRANCE; 

END; 

E 65 <SIZE-ERROR> ::= SIZE ERROR pi 
3 
CALL CODESBYTE(SER); 
CALL UNRESOLVEDS BRANCH; 

END; 

/* 66 <SPECIAL-ACT> ::= <WHEN> ADVANCING <HOW-MANY> */ 

DUDLONOTSIMPLIMENTED:;  /* CAREAGE CONT?OL */ 

ЛЫ 67 X ж/ 


; /* NO ACTION REQUIRED */ 
/* 68 <WHEN> ::= BEFORE ж/ 
CALL NOTSIMPLIMENTED; /* CARRAGZ CONTROL */ 
ps 69 NI AFTER x 

CALL NOTSIMPLIMENTEDs /* CARRAGE CONTROL */ 
а 70 <BOW-MANY> ::= <INTEGERD к / 
CALL NOTSIMPLIMENTED; /* CARRAFE CONTROL */ 
/* 171 \! PAGE ж 

CALL NOTSIMPLIMENTED; /* CARRAGE CONTROL */ 
/* 72 (TYPE-ACTIOND ::= INPUT 53/2 
; /* NO ACTION REQUIRED — VALUE(SP) ALREADY ZERO #/ 
/* 73 \! OUTPUT Е 


GALL SETSTALUE(1); 
/* 74. \! 1—0 < 

GALL SETSVALUE(2); 
y= 25 <SUBID> ::= <SUBSCRIPT> * / 
; ЛЕ VALUE AND VALUEZ2 ALREADY SET */ 
DES 76 С ТВ» x / 

; /* NO ACTION REQUIRED */ 
ү * 77 <INTEGER> ::= <INPUT? */ 
CALL SETSVALUE(CONVERTSINTSGSR) ; 
/* "8 <ID> ::= <INPUT> = 
ШО, 


CALL SETSVALUF(MATCE); 
IP GETSTYPE=UNRESOLVED THEN 
CALL SETSVALUB2(NEXTSAVAILAELS)3 
ШТ); 
/* 29 D> ::- CINPUT» * / 
DO; 








IF NUMERICSLIT TYEN 
БО; 
CALL SETSVALUE(NUMERICSLITERAL); 
CALL SETSVALUE2(STORESCONSTANT); 
END; 
ELSE CALL SETSVALUE(MATCH); 


, 


Le 80 NI <SUBSCRIPT> = 
» /* NO ACTION REQUIRED */ 
/* 81 Ni ZERO ж/ 
ey SHLSVALUB( LITSZERO); 
yx ПОИ OUSS CRI PT> 33= <ID> ( <INPUT> ) = 
CALL CHECKSSUBSCRIPT; 
y 83 <OPT-L/ID> ::= <L/ID> и 
> /* NO ACTION REQUIRED */ 
/ 84 \1 <EMPTY> 27 
; /* VALUE ALREADY SET */ 
~ 85 K<NN-LIT> ::= <LIT> ж / 
DiGi; 


ALPHASLITSFLAG = ALPEASLIT; 
CALL SETSVALUE(NONSNUMERICSLIT); 
"UNES UTSWALUESCSTORESCONSTANT); 


END; 

a 86 BUS NC */ 

CALL SETSVALUE(LITSSPACE) ; 

а 87 М QUOTE pi 

BALD OSETSVALUEC(LITSQUOTE); 

Ы БЕЙЕСЕІТЕДЛА!.? %:- <NN=LIT> E 
> /* М0 ACTICN REQUIRED */ 

WE 89 Xx! <INPUT> Er 

DO; 


ПИ ОИ МЕ Сет TEEN CALL INVALIDSTYPS; 
CALL SETSVALUE(NUMERICSLITERAL); 
CALL SETSVALUE2(STORESCONSTANT); 


END; 
/* 9e КИНО = 
CALL SETSVALUE(LITSZERO); 
pes EMEND AD» .:- CL/ID» ж/ 
; /* NO ACTION REQUIRED */ 
/* 92 NX! «NN-LIT» aay 
; /* NO ACTICN REQUIRED */ 
ИЕ SUONEKOBTCDIT/IDS ::5 <LIT/ID> =/ 
; /* NO ACTION REQUIRED */ 
y= 94 Ni <EMPTY> ж/ 
; /* NO ACTION REQUIRED */ 
/* 95 <PROGRAM-ID> ::= <ID> a 
BATBENGTSTMEBIMENTED, /* INTER PROG COMM */ 
ы 96 Ne * / 
ОЛУ NO ACTION REQUIRED */ 
l= 97 <READ-ID> ::= READ <IDD s 
GALL READSASFILE; 
/* 98 <IF-NONTERMINAL> ::= IF И 
тека = TRUE; /* SET IFSŠFLAG */ 


END; /* END OF CASE STATEMENT */ 
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ENDCODESGEN; 
GETIN1:PROCEDURE BYTE; 
RETURN INDEX1(STATE); 
ENDGETIN1; 
GETIN2:PROCEDURE BYTE; 
RETURN INDEX2(STATE); 
BIDCETIN?; 
INCSP: PROCEDURE; 
VALUE(SP:=SP + 1)=0;  /* CLEAR TEE STACK WEILE 
INCREMENTING */ 
VALUE2(SP)=2; 
DIESE >= PSTACKSIZE TEEN CALL FATALSERROR( SO”); 
ENDINCSP; 
LOOKAHEAD:PROCEDURE; 
IF NOLOOK THEN 
DO; 
CALL SCANNER} 
NOLOOK=FALST; 
IF PRINTSTOKEN THEN 
DO; 
CALL CRLF; 
CALL PRINTSNUMBER (TOKEN); 
CALL PRINTSCHAR(’ ^); 
CALL PRINTSACCUM; 
END; 
END; 
ENDLOOKAHEAD; 
NOSCONFLICT: PROCEDURE (CSTATE) BYTS; 
ШОТАН (CSTATE,I.J,K) BYTE; 
MS INDEXI(CSTATE)> 
EJ INDEXS2(CSTATE) - 1; 
ESI I ТО Е; 
IF RZADi(I)sTOKEN THEN RETURN TRU; 
END; 
RETURNFALSE; 
ENDNOSCONFLICT; 
RECOVER: PROCEDURE BYTE; 
DECORE TSP BYTE, RSTATE RYTZ; 
DO FOREVER; 
TSP-SP; 
DOmWwaI LS ESP <> 255; 
IF NOSCONFLICT(RSTATE :=STATESTACK(TSP)) THEN 
DO; /* STATE WILL READ TOKEN */ 
IF SP<>TSP THEN SP = TSP - 1; 
RETURN RSTATE; 
END; 
TSP = TSP - 1; 
END; 
CALL SCANNER; /* TRY ANOTHER TOXEN */ 
END; 
ENDRECOV ER} 
/* * t * * PROGRAM EXECUTION STARTS HERE * ж */ 
/* INITIALIZATION */ 
TOKEN=635 /% PRIME THE SCANNER WITE -PROCSEDURE- */ 
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CALLMCVE (PASSISTOP-PASSISLEN, .OUTPUTSFCB, PASSISLEN)} 
/* THIS SETS 
OUTPUT FILE CONTROL BLCCK 
TOGGLES 
READ POINTER 
b NEXT SYMBOL TABLE POINTZR 
OUTPUTSEND=(OUTPUTS PTR: =.OUTPUTS BU FF-1 ) +1233 
CALLPRINTSERROR( FALSE); /* INITIALIZE ERROR MSG OUTPUT */ 
f* ж жж жж ж PARSER КБ ж ж жж ху 
DO WHILE COMPILING; 
E STATE <= MAXRNO THEN /* READ STATE */ 
? 
CALL INCSP; 
See GOP ROR (GP) = STATE; /* SAVE CURRENT STATE */ 
CALL LOOKAHEAD; 
I GETIN?; 
aa re E- 
BO I-I TO 
IF READ1(I) = TOKEN THEN 
ро; 
/* COPY THE ACCUMULATOR IF IT IS AN INPUT 
SPRING. IE IT IS As RESERVED WORD IT DOSS 
NOT NEED TO BE COPIED. */ 
IF (TOKEN=INPUTSSTR) OR (TOXEN=LITERAL) THEN 
рО) КЕЙ ТӨ АССОуМ(0); 
VARC(K)=ACCUM(K); 
END; 
STATE=READ2(1); 
NOLCOK=TRUE; 
Sees 
END; 
ELSE 
ТЕ [=Ј TPUEN 
DO; 
CALL PPINTSERROaR(/N?'); 
CALL FRINT(.ERRORSNEARSS); 
CALL PRINTSACCUM; 
IF (STATF:=PECOVER)=G TEEN COMPILINGSPALSEX; 
END; 
END; 
END; /* END OF READ STATE */ 
ELSE 
IF STATE>MAXPNO THEN /* APPLY PRODUCTION STAT: */ 
DO; 
MP=SP - GETIN2; 
MPP1=MP + 1; 
CALL CODESGEN(STATE — MAXPNO); 
SP=MP; 
КЕЕ: 
J-STATESTACK(S?); 
DO WHILE (X:=APPLY1(I)) <> 0 AND JOX; 
Ге +„ 1; 
END; 
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eek = APPLY2(1))=C TEEN COMPILINGSENLSE; 
STATH=K; 

END; 

ELSE 

IF STATE<=MAXLNO THEN *LOOKAREAD STATE*/ 


DO; 
M=GETINI; 
GRLE LOOKAHEAD; 
DO WHILE (K:=LOOK1(1))<>@ AND TOKEN <>K; 
I=1+1; 
END; 
SAT E=LOOK2(1); 
END; 
ELSE 
DO} /*PUSH STATES*/ 
CALL INCSP; 
SIDATESTACK (SP )=GETINZ; 
DATS- CETINI, 
END; 
END;/* OF WHILE COMPILING */ 
CALLBYTESOUT(TER); 
DOWHILE OUTPUTSPTR<> .OUTPUTSBUFF; 
Garo BY TESOUT (TER); 
END; 
RE DCELOSE; 
CALLCRLF; 
CALLPRINT( .BNDSOFSPARTS2); 
ШАТ ВООТ; 
END; 
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INTERP: /* MODULE И рт = ВР “ * / 


К COBOL INTERPRETER ef 
/* NCRMALLY ORG/^ED TO X ’109° ж/ 
/* GLOBAL DECLARATIONS AND LITERALS * / 


DECLARE 
DIT LITERALLY ОТТЕ. 
BDOS LIT “ӘН”, /* ENTRY TO OPEPATING 
STSTEM */ 
BOOT PET “a. 
CR LET Ss, 
LF DET ШЕР? 
TRUE TIT en 
FALSE ТАТ СО. 
FOREVER ТТТ "WHILE TRUE’; 
/* UTILITY VARIABLES */ 
DECLARE 
BOOTER ADDRESS INITIAL (020303), 
INDEX BITE. 
ASCTR ADDRESS, 
CTR ВИЕ, 
UTR BYTE, 
BASE ADDRESS, 
BSBYTE BASED BASE (1) BYTE, 
BSADDR BASED BASE (1) ADDRESS, 
HOLD ADDRESS, 
HSBYTE BASED HOLD (1) BYTE, 
HSADDR BASED HOLD (1) ADDRESS, 
/* CODE POINTESS */ 
CODESSTART [T “320298”, 
PROGRAMS COUNTER ADDRESS, 
CSBYTE BASED PROGRAMSCOUNTER (1) BYTE, 
CSADDR BASED PROGRAMSCOUNTER (1) ADDRESS; 


йы ow GLOBAL INÈRUT AND OUTPUT IOUTINTE T * * * x/ 


DECLARE 
CURRENTSFCB ADIRESS, | 
STARTSOFFSET LIT 2212: 


MON1: PROCEDURE (F,A) EXTERNAL; 
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рака F PITS, A ADDRESS; 
END MONI; 


MON2: PROCEDURE (F,A) BYTE EXTERNAL; 
DECLARE F BYTE, A ADDRESS; 
END MON2; 


PRINTSCHAR: PROCEDURE (CHAR); 
DECLARE CHAR BYTE; 
CALL MON1 (2,CHAR); 

END PRINTSCHAR; 


CRLF: PROCEDURE; 
CALL PRINTSCHAR(CR);3 
CALL PRINT$CHAR(LF); 
END CRLF; 


PRINT: PROCEDURE (A); 
DECLARE A ADDRESS; 
CALL CRLF; 

CALL MON1(9,4); 

END PRINT; 


READ: PROCEDURE(A); 
DECLARE A SDDRESS; 
CALL М0М1(10,А); 

END READ; 


PRINTSERROR: PROCEDURE (CODE); 
DECLARE CODE ADDRESS; 
CAEL CRLF; 
CALL PRINTSCHAR(BIGH(CODE)); 
CALL PRINTSCHAR(LOW(CODE)); 
END PRINTSERROR; 


FATALSERROR: PROCEDURE( CODE); 
DECLARS CODE ADDRESS; 
CALL PRINTSERROR(CODE); 
CALL BOOTER; 

*ND FATALSERROR; 


SZT$DMA: PROCEDURE; 
Capuron CO. CURRENTSFCB + STARTSOFFSET); 
END SETSDMA; 


OPEN: PROCEDURE (ADDR) 3177); 
DECLARE ADDR ADDRESS; 
CALL SETSDMA; /* INSURE DIRECTORY READ WON'T 
CLOBBER CORE */ 
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RETURN MON2(15,ADDR); 
END OPEN; 


CLOSE: PROCEDURE (ADDR); 

DECLARE ADDR ADDRESS; 

IF MON2(16,ADDR)=255 THEN CALL FATALSEPROR( “CL” ); 
END CLOSE; 


DELETE: PROCEDURE; 
CALL MON1(19,CURRENTSFCB); 
END DELETE; 


MAKE: PROCEDURE (ADDR); 

DECLARE ADIR ADDRESS; 

IF MON2(22,ADDR)=255 THEN CALL FATALSERPOR( МЕ“); 
END MAKE; 


DISKSREAD: PROCEDURE BYTE; 
RETURN MON2(28,CURRENTSPCB); 
END DISKSREAD; 


DISK$WRITE: PROCEDURE BYTE} 
RETURN MON2(21,CURRENTS FCB); 
END DISKSWRITE; 


LL D UTLDMTY PROCEDURES * ж ж v жж жу 


DECLARE 
SUBSCRIPT (8) ADDRESS; 


RES: PROCEDURE(ADDR) ADDRESS; 
/* THIS PROCEDURES RESOLVES THE ADDRESS OF A 
SUESICHTPTUDZTIDENTTRTER OR A LITERAL CONSTANT =/ 


DECLARE ADDR ADDRESS; 

IF ADDR > 32 THEN RETURN ADDR} 

IF ADDR < 9 THEN RETURN SU8SCRIPT(4DDE); 
DO CASE ADDR - 9; 


RETURN .(/0^); 
RERUN (C ^) 
RETURN .(7 7); 
END; 
RETURN 2; 
END RES; 


№ 
N 
(O 








MOVE: PROCEDURE(FROM,DESTINATION,COUNT); 
DECLARE (FROM,DESTINATION,COUNT) ADDRESS, 
(F BASED FROM, D BASED DESTINATION) BYTE; 
DO WHILE (COUNT:=COUNT - 1) <> QFFFFE; 
D=F; 
FROM=FROM + 1; 
DESTINATION=DESTINATION + 1; 
END; 
END MOVE; 


БЕКІ: PROCEDURE (DESTINATION, COUNT,CHAR); 
DECLARE (DESTINATION,COUNT) ADDRESS, 


(CHAR,D BASED DESTINATION) BYTE; 
DO WHILE (COUNT:=COUNT - 1)<> 2FFFTH; 
D-CEAR; 
DESTINATION=DESTINATION + 1; 
END; 
END FILL; 


CONVERTSTOSHEX: PROCEDURE( POINTER,COUNT) ADDRESS; 
DECLARE POINTER ADDRESS, COUNT BYTE; 
ASCTR=05 
BASE=POINTER; 
DO CTR = 9 TO COUNT-1; 
BEDENCSHEBUASCTR.O) + SHLWASCTR,1) + BSBYTE(CTR) - 92); 
210; 
RETURN ASCTR; 
END CONVERTSTOSHEX; 


ПА Сора CONTROL PROCEDURES ж * * * */ 
DECLARE 
BRANCHSFLAG BYTE INITIAL( FALSE); 


INCSPTR: PROCEDURE (COUNT); 
DECLARE COUNT BYTE; 


PROGRAMSCOUNTER=PROGRAMSCOUNTER + COUNT; 
END INCSPTR; 


GETSOPSCODE: PROCEDURE BYTE; 
CTR=CSBTTE(0); 
ПРАШИНЕ (1); 

RETURN СТЕ; 

END GETSOP$COD?; 


CONDS BRANCH: PROCEDURE( COUNT); 
IS. PROCEDURE CONTROLS BRANCHING INSTRUCTIONS */ 
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DECLARE COUNT BYTE; 
IF BRANCHSFLAG THEN 
DOS 
BRANCHSFLAG=FALSE; 
PROGRAMS$COUNTER=CSADDR(COUNT); 
END; 
ELSE CALL INCS$PTR(SHEL(COUNT,1)+2); 
END CONDSBRANCH; 


INCRSORSBRANCH: PROCEDURE(MARX); 
DECLARE MARK BYTE; 
IF MARK THEN CALL INC$SPTR(2); 
ELSE PROGRAMSCOUNTER-CSADDR(2); 
END INCRSORSBRANCH; 


LN КШ COMPARISONS << <- есе») 


BEARSCOMPARE: PROC 
BASE=SCSADDR(2) 
HOLD=C$ADDR(1) 
DO ASCTR=@ TO CSADDR(2) - 1; 

DER PETE ASCETR) > HSBITE(RSCTR) THEN RETURN 1; 
IF BSBYTE(ASCTR) < HSBYTE(ASCTR) THEN RETURN 9; 


SURE SY TS; 
? 


END; 
RETURN 2; 
END CEARSCOMPARE; 


STRINGSCOMPARE: PROCEDURE(PIVOT); 
БАТАР PIVOT BYTES 
IF CEARSCOMPARE=PIVOT TEEN BRANCHSFLAG=NOT BRANCHSFLAG; 
CALL CONDSBRANCH (3); 
END STRINGSCOMPARE; 


NUMERIC: PROCEDURE(CHAR) BYTE; 
DECLARE CHAR BYTE; 


RETURN (CHAR »2'0' ) AND (CHAP <="9"); 
*ND NUMERIC; 


LETTER: PROCEDURE(CH4R) BYTE; 
DECLARE CEAR BYTE; 


RETURN (CHAR >=“A ) AND (CHAR <="Z“); 
END LETTER; 


SIGN: PROCEDURE(CHAR) BYTE; 
ПОЛ Ае СНАН BITE, 
RETURN (CHAR="+") OR (CHAR="-"); 
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END SIGN; 


COMPSNUMSUNSIGNED: PROCEDURE; 
BASE=CSADDR(Q)3 
DO ASCTR=@ TO CSADDR(2)—1; 
IF NOT NUMERIC(BSBYTE(ASCTR)) TURN 
DO; 
BRFANCHSFLAGZNOT BRANCHSFLAG; 
RETURN; 
END; 
END; 
CALL CONDSBRANCH(2); 
END COMPSNUMSUNSIGNED; 


COMPSNUMSSIGN: PROCEDUEZE; 
BASE=CSADDR(9); 
DO ASCTR=0 TO CSADDR(2)-1; 
IF NOT(NUMERIC(CTR:2BSBYTE(ASCTE)) 
OR SIGN(CTR)) THEN 
ро; 
BRANCHSFLAG=NOT BRANCHSFLAG; 
RETURN} 
END; 
END; 
CALL CONDSBRANCE (2); 
END COMPSNUMSSIGN; 


COMPSALPHA: PROCEDURE; 
BASE=CSADDR(Q); 
DO ASCTR=@ TO CSADDR(2)-13 
ere NOr LeTTER( BSBYTKE(ASCTR)) THEN 
DO; 
BE ANCHSFLAG=NOT BRANCHSPLAG; 
RETURN; 
END; 
END; 
CALL CONDSBRANCH(2); 
END CCMPSALPEA; 


LE E LC NUMVREC OPERSTIONS * * * * = */ 


DECLARE 

(ПО RINE?) (10) Bun, DE RSICEISTERS */ 
SIGNG(3) BYTE. 

SDEGSPTOFDECSPTI ‚DECSPT2) BYTE 

DEC$PTA (3) BYTE AT (.D3CS2TC), 

OVERFLOW BITE, 
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RE RER BITE, 

SWITCH BUTE, 

SIGNIFSNO BYTE, 

ZONE LIT ТОН, 
POSITIVE ETTI ска 
NEGITIVE ШОТ “O°; 


CHECKS$FORSSIGN: PROCEDURE(CHAR) BYTE; 
DECLARE CHAR BYTE; 
IF NUMERIC(CHAR) THEN RETURN POSITIVS; 
IF NUMERIC(CHAR - ZONE) THEN RETURN NEGITIVE; 
CALL PRINTSFRROR( ‘SI’ )3 
RETURN POSITIVE; 
END CHECKSFORSSIGN; 


STORESIMMEDIATE: PROCEDURE; 
DO CTR-0 TO 3; 
RO(CTR)=R2(CTR); 
END; 
DECS PT@=DECSPT2; 
SIGN2(2)-2SIGN2(2); 
END STORESIMMEDIATE; 


ONESLEFT: PROCEDURZ; 
DECLARE (CTR, FLAG) BYTE; 
IF ((FLAG:=SHR(BSBYTE(@),4))=@) OR (FLAG=9) THEN 
DO; 
DO CTR=9 ТО а; 
Berets CTR )=SEL(BSBYTE(CTR), 4) OR 
SHR(BSBYTE(CTR+1),4); 
END; 
ASBITE(S)sSSEL(BSBYTE(9),4) OR FLA3; 
END; 
1525 CVERFLCW-TRUZ; 
END ONESLEFT; 


ONESRIGHT: PROCEDURE; 
DECLARE CTR BYTE; 


CTR=12; 
DO INDEX=1 TO 9; 
CTR=CTR=-1; 


BSBYTE(CTR)=SER(BSBYTE(CTH),4) OR 
SHL(BSSYTE(CTR-1) ,4)3 
END; 
BSBYTE(2)=SER(BSBYTE(0),4); 
IF BSEYTS(@) = 39H TEEN 
3$8YTE!2) = 99H; 
END ONESRIGHT; 





SHIFTSRIGHT: PROCEDURE( COUNT); 
DECLARE COUNT BYTE; 
DO CTR=1 TO COUNT; 
CALL ONESRIGHT; 
END; 
END SHIFTSRIGHT; 


SHIFTSLEFT: PROCEDURE (COUNT); 
DECLARE COUNT BYTE5 
OVERFLOW=FALSE; 

DO CTR=1 TO COUNT; 
CALL ONESLEFT; 
IF OVEPFLOW THEN RETURN; 
END; 
END SHIFTSLEFT; 


ALLIGN: PROCEDURE; 
BASE=.RG; 
IF DECSPTO » DECSPT1 THEN 
CALL SHIFTSRIGHT(DECSPT?-DEC$SPT1); 
ШӨ САРЫ ӘНІУЛӘБЕРТ ВЕСӘРТІ-ПеС5РТО); 
END ALLIGN; 


ADDSR@: PROCEDURE(SECOND, DEST); 


POIS EDOND, DEST) ADDRESS, (C0Y,A,2,1,J) BYTE; 


HOLD= SECOND; 
EL E = DEST; 
CYs0j 
29; 
ПО = ІС 12: 
A=RO(CTR); 
ВЕЗА ТЕСТЯ ); 
TZDECI(A+CT); 
CY=CARRY ; 
I=DEC(I + B); 
CT CT OR GRARY) AND 1; 
BSBYTE(CTR)=I; 
CTR=CTR-1; 
END; 
IF CY THEN 
DO; 
On Ir 
ВОИ тоя: 
I:B$BYTE(CTR); 
= ПЕСО); 
CY=CARRY AND 1; 
BSBYTE(CTR)=15 
CTR=CTR-1; 
END; 
END; 
END ADDSR@; 








COMPLIMENT: PROCEDURE(NUMB) ; 
DECLARE NUMB BYTE; 


SIGN@(NUMB) = SIGN@(NUMB) XOR 15 /* COMPLIMENT 
SIGN */ 
DO CASE NUMB; 
HOLD=.RG; 
HOLD=.R1; 
HOLD=.R25 
END; 


DO CTR=0 TO 9; 
HSBYTE(CTR)=998H — HSBYTE( CTR); 
END, 


END COMPLIMENT; 


R2ŠZERO: PROCEDURE BYTE; 
DECLARE I BYTE; 
IF (SHL(R2(2),4)<>0) OR (SHR(R2(9),4)<>3) 
THEN RETURN PALSE; 
ELSE DO Беле тона 
IF R2(1)<>@ THEN RETURN FALSE; 
END; 
RETURN TRUE; 
END R2$ZERO; 


CHECXSRESULT: PROCEDURE; 
IF SHR(R2(2),4)=9 THEN CALL COMPLIMENT(2); 
IF SHR(R2(23),4)<>4 THEN OVERFLOW=TRUE; 

END CHECKSRESULT; 


CHECKSSIGN: PROCEDURE} 
IF SIGN@(@) AND SISN@(1) TREN 
DO; 
SIGN@(2)=POSITIVE; 
RETURN; 
END; 
ОТТО ОЕМ Та: 
IF NOT SIGNG(O) AND NOT SIGNO(1) THEN RETURN; 
IF SIGN@(3) THEN CALL COMPLIMENT(1); 
ELSE CALL COMPLIMENT(2); 
END CHECKSSIGN; 


LEADINGSZEROES : PROCEDURE (ADDR) BYTE; 
PECIARE COUNT BYTE, ADDR ADDRESS; 
COUNT=@; 









BASE=ADDR; 

DO CTR=9 TO 9; 
IF (BSBYTE(CTR) AND QFOH) <> 0 THEN RETURN COUNT; 
COUNT=COUNT + 1, 
IF (BSBYTE(CTR) AND ØFH) <> Ø THEN RETURN COUNT; 
COUNT=COUNT + 1; 

END; 

RETURN COUNT; 

END LEADINGSZERCES; 


CHECX$DECIMAL: PROCEDURE; 

IF DECSPT2<>(CTR:=CSBYTE(3)) THEN 

ро; 
BASE=.R2; 
ЈУ РЕСОРТЕ > CTR THEN CALLE SHIPTSRIGHT( DECSPT2-CTR) ; 
ELSE CALL SHIFTSLEFT(CTR-DEC$PTZ); 

END; 

IF LEADINGSZEROES(.R2) < 19 - CSBYTE(2) THEN OVERFLOW 

= TRUE; 
END CHECKSDECIMAL; 


ADD: PROCEDURE; 
OVERFLOW=FALSE; 
Came eh Len. 
CALL CHECKSSIGN; 
CALL ADDR@(.R1,.R2)3 
CALLE CHECKSRESULT; 
END ADD; 


ADPSSERIES: PRCCEDURE(COUNT); 
DECLARE (I.COUNT) BYTE; 
ПОЕТО UNT; 

(РАИ Оена R2 R2); 
END; 
END ADDSSERIES; 


SETSMULTSDIV: PROCEDURE; 
OVERFLOW=FALSE; 
SIGN@(2) = (NOT (SIGN@(@) ТОН SIGN@(1))) AND 016; 
ОЛИ пата и); 

END SETSMULTSDIV; 


RISGREATER: PROCEDURE BYTE; 
DECLARE I 3178, 
DO CTR=2 TO 9, 
IF RL(CTR)>(I:=998-RO(CTR)) THEN ASTUEN TRUE; 
E COT TREN RETURN TALSE; 
END; 
RETURN TRUE; 


236 








END R1SGREATER; 


MULTIPLY: PROCEDURE( VALUE); 
DECLARE VALUE BYTE; 
IF VALUE<X>@ THEN CALL ADDSSERIES(VALUS); 
BASE=.RO5 
CALL ONESLEFT; 
END MULTIPLY; 


DIVIDE: PROCEDURE; 
DECLARE lee E790. 171, Х) BITE; 
GALL SETSMULTSDIV; 
IF (LZ0: -LEADINGSZERCES(.R0))«» 


И Zi = TEPRADINGSZEPORS(.RT))) TEEN 
ШО; 
IF 170>171 TEEN 
DO; 
BASE = RØ; 
CALL SHIFTSLEFT(I := 170-121); 
DECSPTI=DECSPTO + I; 
A 
END; 
ELSE DO; 
BASE = ‚Ri; 
CALL ©НГЕТ5<[ РТ (1:=1721-170); 
DECSPT1=DECPTI + I; 
ЕМЕЛ: 
END; 
END; 


DECPT2= 18 - X * DECPT1 - D*CPTO; 
CALL COMPLIMENT(0); 
ЕСІ -«ҮРТО 19; 
Uca 
DO WHILE R1SGREATSR; 
ATADOS RO (Alia 
IF R1(@) = 993 THEN 
CALL COMPLIMENT (1); 


J=J+1; 
END; 
K-SER(I,1); 
IF I THEN R2(K =z 2 (K) ОВАЈ; 
ELSE R2(X)=R2(K) OR SEL(J,4); 
ВАБ ЕЕ КА, 


CALL ONESRIGHT; 
END; 
END DIVIDE; 


LOADS ASCHAR: PROCEDURE(CHAR); 
DECLAR® CHAR FYTE; 








IF (SWITCH:=NOT SWITCH) THEN 
BSBYTE(RSPTR)=BSBYTE(KSPTR) OR SHL(CHAR – 322H,4); 
ELSE BSBYTE(RSPTR:=RSPTR-1)=CHAR - 3955; 

END LOADSASCHAR; 


LOADSNUMBERS: PROCEDURE(ADDP,CNT); 
DECLARE ADDR ADDRESS, (I,CNT)BYTE; 
HOLD=RES(ADDR); 


CTR=CNT; 
DO INDEX = 1 TO CNT; 

CTR-CTR-1; 

CALL LOADSASCHAR(ESBYTE(CTR)); 
END; 


CALE INCSPTR(5); 
END LOADSNUMBERS; 


SETSLOAD: PROCEDURE (SIGNSIN); 
DECLARE SIGNSIN BYTE; 
DO CASE (CTR:=CS$BTTE(4)); 


BASE-.R0; 
BASE-.R1,; 
BASE=.R2; 


END; 
DECSPTA(CTR)=CSBYTE(S); 
SIGNO(CTR)-SIGNSIN; 
CALL PILL (BASZ,19,9); 
RSPTR=9; 
SWITCH=FALSE; 

END SET$LOAD; 


LOADSNUMERIC: PROCEDURE; 

CAD SETSLOAD (1); 

CALL LOADS$ NUMBERS (CSADDR(B),CSBITE(2)); 
END LOAD$NUMER IC; 


LOADSNUMSLIT: PROCEDURE; 
DECLARE LITSSIZE, FLAG) BTTZ; 


CHARSSIGN: PROCEDURE; 
те Теле — 1; 
HOLD=HOLD + 1; 

END CHARSSIGN; 


Le SIZE CSRI 
EOLD=CS5ADDA(4 
IF ESBYTE(2)=*- 
DO; 

CALL CHAP$SSIGN; 

ИЛА ПО s LOMD(NEGITIVE); 





ELSA DC; 
IF HSBYTE(@)="°+° THEN CALL CHARSSIGN; 
GALL SETSLOAD( POSITIVE); 

END; 

ELAC =Ø; 

СЕЕ ЕТТЕ; 

ПОЕ Е ТО LITSS1Z 8; 
СЕТЕ 


IF HOBYTS(CETR)=°.° THEN FLAC=SLITSSIZE - (CTR+1); 


ELSE CALL LOADS$ASCHAR(ESBYTE(CTA)); 
END; 
DECSPTA(CSBYTE(4))= FLAG; 
CALL INCSPTR(5); 
END LOADSNUMSLIT; 


STORESONE: PROCEDURE; 
IF(SWITCE:=NOT SWITCH) THEN 
BSBYTE(Q@)=SHR( HSBYTE(@) ,4) OR 9° 
ELSE DO; 
HOLD=HOLD-1; 
BSBYTES(@)=(HSBYTE( 9) AND @FH) OR е”; 
END; 
BASE=BAST-15 
END STORESONE; 


STORESASSCHAR: PROCEDURE(COUNT); 
DECLARE CCUNT BYTE; 
SWITCH=FALST; 

FOLD=.R2 + 9; 
DO CTR=1 TO COUNT; 
CALL STORESONE; 
END; 
END STORESASSCBAR; 


SETSZONS: PROCEDUR? (ADDR); 
DECLARE ADIR ADDRESS; 
IF NOT SIGNO(2) TEEN 
DO; 
BASE=ADDR; 
BSBYTE(Z)=BSBYTE(@) OR ZONE; 
END; 
НИТ ЕРЕ), 
END SETSZONE; 


SETSSIGNSSEP: PROCEDURE (ADDR); 
DECLARE ADDR ADDRESS; 
BASE=ADDR; 

IF SIGNO(2) THEN 3$ 2YTE( 2)=+°; 
ЕЕЕ ВЕ (О) ==“; 
CALL INCSPTR( 4); 
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END SETSSIGNSSEP; 


STCRESNUMESIC: PROCETURFS 
CALL CEECKSDECIMAL; 
BASE=CSADDR(@) + CSBYTE(2) -1; 
CALL STORESASSCHAR(CSBYTE(2) ); 
END STORESNUMERIC; 


FI INPUT-OUTPUT ACTIONS * * * ж ж жу 


DECLARE 
EOFSFLAGSOFFSET IT 736”, 
BRAGSOFFSET LIT Nc 
EXTENTSOFFS ET ПЕТ yo 
RECSNO BIT m 
PTRSOFFSET LIT do 
BUFFSLENGTH ЕТТ а 
VARSEND ETT "GR 
TERMINATOR LIT "МАН, 
HIGHSVALUE eee “OFFH’, 
INVALID үтү, 
REWRITES FLAG BYTE INITIAL (0H), 
RANDOMSFILE BYTS, 
CURRENTSFLAG BYTE, 
FCBSBYTE BASED CURRENTSFCRB BYTE, 
FCBSADDR BASZD CUPRENTSFCB ADDRESS, 
FCRSEYTSSA BASED CURRENTSFCR (1) BYTE, 
FCRSADDRSA BASED CURRENT$SFC3 (1) ADDRESS, 
BUFFSPTR ADDRESS, 
BUFFS END ADDRESS, 
BUFFSTART ADDRESS, 
BUFFSBYTS BASED BUFFSPTR BYTE., 
CONSRUFF ADDRESS INITIAL (89H), 
CONSBYTE BASED CONS3UFF BY Le. 
CONSINPUT ADDRESS INITIAL (82H); 
ACCEPT: PROCEDURZE; 

ПА ОИ; 


CALL PRINTSCHAR(371); 

ЖЕЛГЕН, И 
ООШ ee ТӘНЕТІРПТ,(СОМ6ӨВҮТЕ:-С5ЗТТЕ(2)),” ^); 
CALL READ(CONSBUF?); 
CALL MOVE(CONSINPUT,RES(CSADDR(2)),CONSBITE); 
SITTEINC-ITR(3), 

IND ACCEPT; 
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DISPLAY: PROCEDURE; 
DECLARE BSCNT BYTE; 
BASE=CSADDE(2); 
IF NOT CSEYTE(3) THEN CALL CRLF; 
БЕРЕ Бест (2); 
DO CTR = Ø TO BONT = 1; 
CALL PRINTSCHAR(BSBYTE(CTR)); 
END; 
CALL INCSPTR(4); 
END DISPLAY; 


GETSFILESTYPE: PROCEDURE BYTE; 
BASE=CSADDR(9); 
RETURN BSBYTE(FLAGSOFFSET); 
END GETSFILESTYPE; 


SETŠFILEŠTYPE: PROCEDURE(TYPE): 
DECLARE TYPE BYTE; 
BASE=CSADDR(@); 
MEETS PILES TIPE<>O THEN CALL FATALSERROR( “OR ); 
BSBYTE( FLAGSOFFSET)=TYPE; 
AO eSSTSPI LEST IPE; 


SETSISO: PROCEDURE; 
INVALID=FALSS; 
IF CSADDR(2)=CURRENTSFCB TEEN RETURN; 
/* STORE CURRENT PCINTERS AND SET INTZENAL 
WRITE MARK */ 
BASS=CURRENTSFCB; 
FCBSADDRSA (PTRSOFFSET)= 
FCBSBYTESA(FLAGSOFFSET) 
/* LOAD NEW VALUES */ 
BUFFSSND2(3UFFSSTART:2(CURRENTSFCB:2C$ADD2'/2)) 
+ STARTSOFFSET) + BUFFSLENGTE; 
CURRENTSFLAG=FCESBYTESA(FLASSOFFSET); 
BUFFS PTR=FCBSADDRSA(PTRSOFFSET); 
END SETSI$03 


BUFFS PTR; 
=CUCKENTSE LRG: 


OPENSFILE: PROCEDURE(TYPE); 
DECLARE TYPE BYTE; 
CL LESERSEILESTYIPE(TYPR); 
CTR=OPEN(CURRENTSFCB:=CSADDR(O)); 
DO CASE TYPE-1; 
/* INPUT */ 
РО; 
IF CTR=255 TEEN CALL FATALSERROR( NF’); 
END; 
/* OUTPUT */ 
DO; 


MM 





CALL DELETE, 
CALL MAKE(CSADDR(2)); 


END; 
; /* CASE 2 NOT USED */ 
/* I-0 */ 
DO} 
IF CTR=255 THEN CALL FATALSERROR( МЕ); 
END; 
END; 
FCBSBYTESA(FXTENTSOFFSET)-0; /* SET THE EXTENT FIELD 
IN FCE */ 
FCBSBYTESA (RECSNO )=@3 /* SET THE RECORD NUMBER 
IN FCB */ 


FCESBYTESA (SCFSFLAGSOFFSET)=FALSE} 

Poo THE EO? INDICATOR OFE </ 
BUFFSEND=( BUFFSSTART:=(CUREENTSFCR + STARTSOFFS=T)) 
+ RUFFSLENCTE; 
CURRENTSFLAG=FCBS3YTSSA(FLAGSOFFSET) 3 
BUFFSPTR,FCBS$ADDFSA(PTPSOFFSET)-83UFFSSTA2T-1: 
CALL INCSPTR(2); 

END OPENSFTILE; 


WRITESMARK: PROCEDURE BYTE; 
RETURN ROL(CURRENTSFLAG,1); 
3ND WRITESMARK; 


SZTSWPITESMARK: PROCEDUEZ; 
CURRENTSFLAG=CURRENTSFLAG OR 208; 
END SETSWRITESPARK;, 


WRITESRECORD: PROCEDURE; 
CALL SETSDMAS 
CURRENTSFLAG=CURRENTSFLAG 4ND ДЕН; 
IF (CTR:=DISK$wRITE) =@ THEN RETURN; 
CALI EPRINT RICI АЗ ); 
INVALID=TEUE; 

END WRITESRECORD; 


READSRECORD: PROCEDURE; 
ASS DIMAS 
IF WRITESMARK THEN CALL WRITESRECORD; 
Tal CT DISKSZBAD)=Q THEN RETURN: 
ТБН TORN FOBSBITSSA(ECESPEASSOTFSET)-TRUZ; 
INVALID=TRUS; 
*ND READSRECORD; 


READSEYTE: PROCEDURE BYTE; 
IF (BUFFSPTR:=3UFFSPTR + 1) >= 3UFFEND THEN 
DO; 
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(АКГ ЕК Ге КОО Яр; 
IF FCBSEYTESA( FOPSFLAGSOFFSET) THEN 
RETURN TERMINATOR; 
BUFFS PTR=BUPFSSTART; 
END; 
RETURN BUFFSBITE; 
END READSBYTE; 


Мошо ва: PROCEDURE (CHAR); 
ПОВЕ CHAR BRYTE; 
= (BUFFS 2TR:=BUFFSPTR+1) >= BUFFSEND THEN 
) 
CALL WRITESRECORT; 
BUFFSPTR= 3UPFSSTAZT; 
IF REWRITESFLAG THEN 
DCS 
САМИ wen = CORD; 
PFCESBYTESA(RECSNO)=FCBSEYTESA( RECSNO)- 


END; 
CALL SETSWRITESMARK ; 
BUPFSBYTE=CHAR} 

END WRITESBYTE; 


WRITESENDSMARK: PROCEDURE; 
Cpu LISP YT<( CR); 
(СО КЫШ oO TESRYTEC LE); 

END WRITESENDSMARX; 


PEADSENDSMARX: PROCEDURE; 
IF READSBYTEC>CR THEN CALL PRINTSERPCR( “5M” ); 
Han ATS SYTECOLE THEN CALL PRINTSERROR|('EM ); 
END EEADSENDSMAPK; 


BERDSVARIAELE:PRCCZDURE; 

Clube ont isc; 

BASEZCSADDR(1); 

DOR CAR O TO CSADDR(2)-1; 
ieee he =i Be AY TR( ASCO) s=RSADSBYTE)) = VARSEND THEN 
DO; 

CTR=READS BYTE; 
RETURN; 
OND; 
IF CTR=TERMINATCR THEN 
DOS 


3 


FCBSBYTTSA(EOFSFLAGSOFFSET7)STRUT; 
RETURN; 
END; 
END; 
CALL READSENDSMARKÉ; 
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¿ND READSVARIABLES 


WRITESVARIABLE: PROCEDURE; 
DECLARE COUNT ADDRESS; 
CALL SETSISO; 
BASESCSADD3(1); 
COUNT=CSADDR (2); 
DO WHILE(B$RYTE(COUNT:=COUNT-1)<>° “)AND (COUNT<>G); 
END; 
DO ASCTR=@ TO COUNT; 
n CALL MWEITESBYTE(2S31TE(ASCTR)); 
ND; 
CALL WRITESENDSMARK; 
2ND WRITESVARIA2LES 


3EADSTOSMEMORY: PROCEDURE; 
EASE=CSADD32(1);3 
ПРОШАО шлем PCP CSADDR( 2) 
IF (BSRYTU(ASCTR) 
TO 


-1; 
-nmDesuUy-TESMDPNSTOS TEEN 
$ 


*CBSBRBYTESA(ECTSTPLAGSOFFSET)-TRU-; 
RETURN; 


rm 


ND; 

END; 

CALL READSENDSMARK; 
IND READSTOSMEMORY; 


WRITESFROMSMEMCRY: PROCEDURE; 
BASB=CSADDE(1); 
DO ASCTR=2 TC CSADDR(2)-13 
CALL wMl TESRYTE(BSBYTS(ASCTR)); 
END; 
CALL WRITESENDSMARK $ 
END WPITESFROMSMEMORY; 


/* * % % * RANDOM I-@ PROCEDURES * ж * */ 


SETSRANDOMS POINTER: PROCEDURE; 
/ж 


THIS PROCEDURES READS TRE RANDOM KZY AND COMPUTES 
WHICH RECORD NEEDS TC 3B AVAILABLE IN THE 3UFTER 
THAT ZECORD IS MADE AVAILABLE 4ND THE POINTERS 
527 FOR INPUT OR OUTPUT 

Е 


Deora ( SYP SSCOUNT -2ECGRD) ADDRESS, 
ВТЕ; 
INEM PESMARKE TEEN CALL WRITESRECORD; 
Bro CSADDEL 2) #2 (CONE RTSTOSHEX(CSADDR(S3) 
,CSBITE(R))-1); 





OR SEHE PITNSCHOUNT, 7); 
BRTAND-SHZ(RECORL, 7); 
IF EXTENT< DFCBSBYTESA(E XTENTSOFSSET) THEN 
DO; 
CALL CLOSE(CSADDR(A)); 
FC3$BYTESA(EXTENTSOFFSET)-ZXTENT; 
IF OPEN(CSADDR(Q))«»0 THEN 
DO; 
IF SHR(CURRENTSFLAG,1) THEN CALL MAXE(C$ADDR(9)); 
ZLSE INVALID=TRUE; 
END; 
END; 
BUFFSPTR=(PYTESCOUNT AND 7FE) + BUFFSSTART -1; 
Bum NM LO FUERE CO2D) AND ТЕН; 
CALL 2EADSRECORD; 
END SETS 2ZANCOMSPCINTSER; 


FETSRECSNUMBER: PROCEDURE ADDRESS; 
DECLARE (RECORD, LOGICALSRECSNUM,BYTESCOUNT) ADDRESS; 
RECORD=SHL(FCRSBYTESA (SXTENTSOFFSET) ,7) 
+ FCBSBYTESA(RECSNO ); 
IF NOT SUR (CURRENTS FLAG, 1) THEN ПЕСО ISSO ADSL. 
BYTESCOUNT=SAL{RECORD, 7) + ((BUFFSPTR+L)-BUFFSSTART); 
LOGICALSRECENUM=(BYTESCOUNT/(CSADDR(2)+2))+1; 
RETURN LOGICALSRECSNUM; 

IND GETSRECSNUMBER; 


SETSRELATIVESXEZY: PROCEDURE; 
DECLARE (R ПЕСМИ X) ADDRESS, 
AS CNT) Ta, 
1(4) ADDPESS DATA (12228,10002,1288,10), 
S Eien 
RECSNUM=GETSRECS NUMBER; 
Om TO 3; 
CNT=9; 
DO WHILE RECSNUM>=(X:2=J(1)); 
RECSNUM=RECSNUM - X; 
CHT=CNT + 1; 
240; 
SURE посмт + 2; 
END; 
BUFF ‘4)=RECSNUM+ ‘Q $3 
IF (1:=CS3YT3(S8))<=5 THEN 
CALL MOVE( .BUFF+5-I ,CSADDR(3),1); 
MUSS 
ШІН сеаррн(а) I-5. |); 
CALL MOVE(.BUFF,CSADDR(3)+1-6, 5); 
D; 


EN 
END SEBSRELATIVESKSY; 


WRITESEMPTYSRECORD: PROCEDURE; 
DO ASCTR-1 TO CSADDR(2); 
CALL WRITESBRYTE(HIGHSVALUE); 
END; 
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CALL WRITES ENDSMARK ; 
END WRITESEMPTYSRECORD; 


WRITESDUMMYSHECORDS: PROCEDURE(DIFFERENCE); 
DECLARE DIFFERENCE ADDRESS, COUNT BYTE; 
DO COUNT=1 TO DIFFERENCE; 
CALL WRITESEMPTYSEECORD; 
END; 
END WRITESDUMMYSRECORDS; 


BACKSONESEXTENT: PROCEDURE; 
CALL о оке соларни ај 
IF FCBSBYTESA(EXTENTSOFFSET): 
FCBSBYTESA(EXTENTSOFFSET)-1- 
CALL FATALSERROR('W7') 
IF OPEN(CSADDR(2O))C»Q0 THEN 
DOS 
ФАП РЕПШЗЕСОРІ СОР?); 
INVALID-TRUE; 
RETURN; 
END} 
FCRSBYTESA (RECSNO)=127;3 
END BACKSONESEXTENT; 


250° VEEN 
, 


BACKSONESRECORD: PROCEDURE; 
IF( BUF FSPTR : =2UFFSPTR-(CSADDR(2)+2) )>=BUPFSSTART-1 THEN 
50; 
FCBSRYTESA(RECSNO)sSFCBSBYTEZSA(RECSNO)-1; 
AETURN; 
ЈЕ 
BUPFSPTR=BUPFSEND—(BUFFSSTART-BUFFS PTS) ; 
IF FORS3YTESA(RECSNC)=@ THEN 
DO; 
CALL BACKSONESEXTENT; 
IF INVALID TEEN RETURN; 
CALL READSRECORD; 
CAL BACKSONTS EXTENT: 
END; 
ELSE 
DO; 
FCBSBYTESA(RECSNO)=FCBSBYTRESA(R=ECSNO )-2; 
CALL READSRECOED; 
FCBSEYTESA(RECSNO)=FCBSAYTESA(RECSNO)-1; 
END; 
END BACKSONESRECORD; 


REWRITESSEQ: PROCEDURE( FLAG); 

ПИСТА FLAG BYTE: 

CALL BACXSONESRECORD; 

REWRITESFLAG=TRUE; 

IF FLAG THEN CALL WRITESFROMSMEMORTY; 

/* THIS IS A REWRITE */ 
ELSE CALL WRITESZMPTYSRECORD; = TAS MS 
A DELETE */ 





CALL WRITESRECORD; 
FCESBYTESA(RECSNO) =FCBSBYTESA(RECSNO)-13 
REWRITESFLAG-FALSE; 
CALL READSRECORD; 
END REWRITESSEQ; 


CHECKSDIFFERENCE: PROCEDURE; 

DECLARE (DIFFERENCE,NEXTSRECORD,NEXTSKSY) ADDRESS; 
NEXTSRECORD=GETSRECSNUMEER;} 
NEXTSXEY =CONVERTSTO$ HEX (CSADDR(Z),CSBYTE(2))3 
IF NEXTSRECORD > NEXTSKEY THEN CALL FATALSERROR( “W2"); 
DI FFERENCE=VEXTSKEY-NEXTSRECORD; 
IF DIFFERENCE > @ THEN 
CALL WRITES DUMMYSRECORDS (DIFFERENC2); 

END CHECKSDIFFERENCE;} 


fee RK RK KH MOVES ж FF жож жож ж/ 


INCSHOLD: PROCEDURE; 
HOLD=HOLD + 1; 
CTR=CTR + 1; 

END INCSHOLD; 


LOADSINC: PROCEDURE; 
Н5ЗВҮТЕ(@)=3$ВҮТЕ(@); 
BASF=BASE+1; 
CIR1=CTR1 + 1; 

CALL ЇМС5НО15; 

END LOADSINC; 


CHECKSEDIT: PROCEDURE(CHAR); 
DECLARE CHAR BYTE; 
IF (CHAR-'O^) OR (CHAR="/°) THEN CALL INCSHOLD; 
ELSE IF CHAR="3” TEZN 
DOS 
Н5ВҮТЕ(2)-” 7; 
CALL INC$SHOLD; 
END; 
ELSE IF CEAR="A”" TEEN 


) 

IF NOT LETTER(BSBYT®(@)) THEN CALL PRINTSERROR( “IC’)3 
CALL LOADSINC; 

Qe 

ELSE IF CHa2="9” THEN 

DO; 
IF NOT NUMERIC (393YTE(Q)) THEN 
BALLSPOINESTRROR( IC ); 
Avge Oa > INC s 

END; 

ELSE CALL LOADSINC; 

END CHECKSEDIT; 
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ee ROTE АСТ МИ R ok k o*/ 


STOP: PRCCEDURZ; 
EP RIN TRAD Or JOB 5°)); 
CALL BOOTER; 

END STOP; 


/ Ж ж ж ж ож ж ж о ж ж ж ж ж ож жож ж 


THE PROCEDURE BELOW CONTROLS THE EXECUTION OF THE CODE. 
IT DECODES EACH OP-CODE AND PERFORMS THE ACTIONS 


ж ж ж ж RK OR ж ж ж ж ж ож/ 


EU TE: PROCEDURES 
DO FOREVER; 
DO CASE GTTSOPSCODE; 
3 AE CASE ZERO NOT USED +7 
/* @1: ADD */ 
CALL ADD, 
Po Ge: SUB #7 


DO; 
CALL COMPLIMENT(2); 
IF SIGN2(20) THEN SIGNO(Q)=NEGITIVE; 
ELSE SIGNI(B)=POSITIVZ; 
САГГ АФР: 
END; 


/* Q3: MUL */ 


DO; 
DECLARE 1 BYTE; 
CALL SETSMULTSDIY; 
DECPT1, DECPT2-DECPTI DEC PTS; 
CALL ЕСМ; 
CALL MULTIPLY(SHR(?21(I:=9),4)); 
Bor AOS 
CALL MULTIPLY(R1(I:=I-1) AND ABE); 
CALLTMULTI P LI(SHR(RI(I), 
IND; 
END; 


/* Zas DIV */ 


CALL DIVID:; 


ГӘ 
Ha 
(D 





"b OS 


/* 06: 


/ж 08: 


и 19: 


күт. 


МЕС */ 
BRANCHSFLAG=NOT BRANCHSFLAG; 
STP */ 
CATLISSTODS 
STI */ 
CALL STORESIMMEDIATE; 
RND */ 
DO; 
CALLS TORRES IMMEDIATE,; 
СОНОР eR 2, 10,0) 3 
R2(9)21; 
CALL ADD; 
END; 
ИРЕТ У 
ро; 
IF CSADDR(@)<>@ THEN 
De: 
МОНЕ СОЛО 0); 
C$ADDa(0)-0; 
PROGRAMSCOUNTER-ASCTR; 
END; 
BPLSE CALL UNOS PIAR 207 
END; 
CLS 4/ 
ро; 
CALL SET$I$O; 
IF WRITESMARK THYEN 
DOS 
IF NOT SHR(CURRENTSFLAG,2) TEEN 
CALL WORITESSYTE( TERMINATOR) ; 
CALL WRITESRECCRD; 
END; 
ELSE 
CALL SETSDMA; 
А а о ео: 
FCESBYT25A( FLAGSOFP FSET) =@3 
CALL INCSPELR(2); 
шр: 
SER */ 
DO, 





(= 


/* 


/* 


/* 


/* 


12: 


zo: 


ES 


17: 


18: 


19: 


IF OVERFLOW THEN PROGRAMSCOUNTER 
= ИБАР АИ); 
PESE CALL INCSPTR(2); 


PROGRAMŠCOUNTER=C$ADDR(); 
OPN */ 


DO; 
CALLE Lo 
CALL READSRECORD; 
END; 


E 


CALL OPENSFILE(2); 


: 0Р2 */ 


DO; 
(j= Seis toes SO BACH TYPE SETS ONLY 
ONE BIT IN CURRENTSFLAG */ 
CALL OPENS#PILE(4); 
CALL READSRECORD; 
END; 


RGT */ 


DC; 
IF NOT SIGN@(2) THEN 
BRANCHSFLAG=NOT BRANCHSFLAG; 
CALL CONDS3RANCH (2); 
END; 


RPL 7 


DO} 
IF SIGN@(2) THEN 
BRANCHSFLAG=NOT BRANCHSFLAG; 
CALL CONDSBRANCH( 2); 
END; 


REQ */ 


DO; 
IF R25ZERO THEN 
BRANCHSFLAG=NOT BRANCSSFLAG; 
CALL CONDSBRANCH(0); 
END; 


INV */ 





/ 


/* 


/ж 


/* 


I5 


CALL INCRSORSBRANCH(INVALID); 
20: EOR */ 
CALL INCRSORSBRANCH(FCBSBYTESA(EOFSFLAGSOFFSST)); 
АССИ 


CALL ACCEPT; 


22: STD */ 
DO; 
Goby Io) =o, 
CALLED OP RAY; 
САТЫ СТОР 
END; 
х 25: LDI */ 
ШО, 
CSADDR(2)=CONTEPTS TOSHEX(CSADDRÍ(Z) 
,CSBYTE(2))+13 
CALL INCSPTR(2);3 
END; 
24: TIS %/ 


CALL DISPLAY; 
Coe ea), 


DO; 
I* CS$ADDR(OG)X»G THEN CSADDZ(40) 
= C$ŠADDR(Ø)-1; 
IF CSADDR(2)20 THEN 
PROGRAMSCOUNTER = CSADD2(1)3 
ELSE CILL INCSPTR(4); 
END; 
26: STO */ 
DO; 
КГ ОШО; 
CALL INCSPTR(4); 
END; 
27: M 
DO; 
CALL STORSSNUMERIC; 
CALLAS ES ZONA Con ODR( 2) ); 
END; 





/ 


/ 


/ 


/* 


/* 


28: 


29 


OD. 


51: 


52: 


зу: 


34: 


51/2 24 


DO; 


END; 
SETS) 
DO; 


END; 
5714 */ 


DO; 


END; 
Shera. 
DO; 


END; 
LODE- 
CALL 


реу 


ГІ STORS NUMERIC; 
CALL SETSZONE(CSADDR(@)+CSBYTE(2)-1); 


CALL CHECKSDECIMAL; 

BASE-CSADDR(O) + CSBYTE(2); 

CALL STORE ASSCHAP(CSBYTE(2) = 1); 
CALL SETSSIGNSSEP(CSADDR(2)); 


CARLIN CHECK > DECIMAL, 
BASE-CSADDR(O) + CSBYTE(2) -1; 
CALL STORESASSCHAR(CS.EYTE(2)-1); 


САЛ E TAME NES EPICA DD NO) +0 BIS (2)-1)> 


CALL ORECKS DECIMALI 

R£(9)-R2(9) OR SIGN2(2); 

CALL MOVE(.R2 + 98 - CS$3YTE(2),CS$ADDR(0) 
реза), 

CALL INCSPTR(4); 


LOADSNUMSLIT; 


CALL LOADSNUMERIC; 


LD2 */ 
Dos 


HOLD=CSADDR(@); 
IF CHECKSFORSSIGN(HSBYTES(2)) THEN 
DO; 


CALE ETS LOAD POSITIVE); 
CALL LOADSNUMBERS (CSADDR(G) ,CSBYTE(2)); 


END; 
ELSE DO; 


CAEL SETS LOAD ANEGCGITIVS); 


do 





SND; 


Ио LDS */ 


whe 
2 


3 


/* 


DO; 


END; 


36: LD4 */ 


T 


323: 


DO; 


END; 


ни 


DO; 


END; 
LD6 */ 


DO: 


CALL LOADSNUMBERS(CSADDR(@)+1 
СӘНШЕ(2)-1); 
CALL LOADSASCHAR(ESBYTE(2)-ZONE); 


END; 


DECLARE І BYTE; 
HOLD=C$ADDR(2); 
IF еи. 


CSBYTE{2)-1 THEN 
DO; 
О ОНА POSITIVE); 
I=I +1; 
END; 
ELSEFDO; 


САПЫ СЕТЕТОАР(МЕСІТІЛЕ); 
CALL LOADSASCHAR(CTR-ZONE); 
END; 
CALL LOADSNUMBERS(CSADDR(0),1); 


HOLD=C$ADDR(Ø); 

ОЧЕВУ ТЕС ЕВО TREN CALL SETSLOAD(1); 
BLSE CALL SETSLOAD(@); 

CALL LOADSNUMBERS (CSADDR ( @),CSBYTE(2) -1); 


HOLD=C$ADDR (2); 
IF HSBYTE(CSBYTE(2) - 
GALE SETSLOAD( 1): 
ELSE CALL SETO LOAD(A); 
(CSA 


3 
' 
CALL LOADSNUMBERS ПОЕ СОС ВТТВ(2) 1); 


DEOTARSAT. BITE: 

HOLD=C$ADDR(O); 

Cie ooh Onn Gio pr me | =совут“(2)=1)); 

BASE=BASS + 9 - І; 

ро Ста = gam 
BSBYTE(CTH)=HSBYTE(CTR); 

END; 

Romie Cle ВЕЗЕР (СТУ) Ар QY98; 
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CALL INGSPTR(5); 
END; 


/* 39: PER */ 


DO; 
BAS S=CoADD ed +1; 
ESADDR(8)=C$ADDR(2); 
PROGRAMSCOUNTER=CSADDR (2); 
END; 


/* 4&0: CNU */ 

CALL CCMPSNUMSUNSIGNED; 
е 41% CNS */ 

CALL COMPSNUMSSIGN; 
P42: CAL */ 

CALL COMPSALPEA; 
/* 43: RWS */ 


DC; 
ALAS ETS TSO 
ЇР NOT SHR(CURRENTSFLAG,2) THEN 
CALL FATALSERROR(/W6'); 
IF NOT FCBSBYTESA(EOFSFLAGSOFFSET) THEN 
CALL REWRITSSSEQ(T); 
CALL INCSEPERIG); 
END; 


/* 44: DLS */ 


Dos 
CALL SETSI $03 
IF NOT SER(CURRENTSFLAG,2) THEN 
CALL FATALSERROR( Уб); 
IF NOT FCBSBYTESA(EOFSFLAGSOFFSEZT) THEN 
CALL REWRITESSEQ(0); 
CALL INCSPTR(6); 
END; 


sut ND -/ 


DO; 
CALL SETSISO; 
IF NOT CURRENT$FLAG TEEZN 
CALL FATALSEEROR(/W5'); 
IF NOT FCBSAYTESA(EOFSFLASG 
CALL READSTOSMEMORY 
CALL INCSPTR(6); 


$OFFSZT) THEN 
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m = 


Sa. a 


E E 
ve 


o 
: 











END; 


ғар: WTE */ 


DO; 
CALL SER 150; 
IF NOT SHR(CURRENTSFLAG,1) THEN 
CALL FATALSERROR(/w3^/); 
CALL WRITES FROMSMEMORY; 
GCLLL INCSPTR(G); 
END; 


Bar: RVL / 

CALL READSVARIABLE; 
/* 48: WVL */ 

CALL WRITESVARIABLE; 


24090: 505057 


Do: 
SUBSORI So (CSeure(2) |= 
CONVERTSTOSHEX(CSADDR (2) ,CSBYTE(2));3 
CALL INCSPTR(4); 
END; 


/* 580: SGT */ 
CALL STRINGSCOMPARE(1); 
/* 51: SIT */ 
CALL STRINGSCOMPARE(Q); 
/я 52: SEQ */ 
CALL STRINGSCOMPARE(2); 
/* 53: MOV */ 
DOS 
CALL MOVE(RES(CSADDR(1)),RES(CSADDR(Q) ) 
,CSADDR(2) ); 
PE CSADDR(3)<>0 TEIN CALL 
FILL(RES(CSADDR(O)) + CSADDR(2) 
ОБРОК За ЕС); 
САРПЕК INCSPT RS) > 
END; 
/* 54: RES */ 


DO; 





CAL GOSH fo lsu, 
IF SHR(CURRENTSFLAG,1) THEN 
CALL FATALSERROR('/w5'); 
IF NOT FCBSBYTESA(EOFSFLAGSOFFSET) TEEN 
DO; 
CALL SEESKELADIVESERE, 
CALL READSTOSMEMORI; 
END; 
CALL INCSPTR(9); 
END; 


Ш 5155: WRS */ 


DO; 
САПЫ SET>150, 
IF NOT SHR(CURRENTSFLAG,1) THEN 
CALL FATALSERROR(/Aw1^); 
CALL CBECKSDIFFERENCE; 
CALL SETSRELATIVESKEY; 
CALL WRITESFROMSMEMORY; 
CALL INC$PTR(9); 
END; 

/* 56: RAR */ 


DO; 
CALL oe TS so. 
IF SER(CURRENTSFLAG,1) THEN 
CALL FATALSERROR(/W5'); 
CALL SETSRANDOMSPOINTER; 
IF NOT INVALID THEN CALL READS$TOSMEMORT; 
IF VALID TEEN 
FCBSBYTESA( FOFSFLAGSOFFSST )=FALSE;} 
CALL INCSPTR(9); 
END; 
/* 57: WRR */ 


DO; 
DECLARE DIFFERENCE ADDRESS; 
CALL SET$ISO; 
IF SHR(CURRENTSFLAG,1) THEN 
DO; 
CALL CHECKSDIFFERENCE; 
CALL SETSRELATIVESKEY; 
CALL WRITESFROMSMEMORY; 
END; 
ELSE 
DO; 
IF SER(CURRENTSFLAG,2) TEEN 
pos 
CALL SETSRANDOMSPOINTER; 
IF NOT INVALID THEN 
DOS 
IF (.BUFFSPTR+1L)=HIGHSVALUE THEN 
DO; 
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REWRITESPLAG-TRUE; 
CALL WRITESFROMSMEMORY 3 
REWRITESFLAG-FALSE; 


END; 
ELSE 
CALL PRINTSERROR('WA4'); 
END; 
ELSE 
CALL FATALSERROR( °W37 )3 
END; 
END; 


CALL INCSPTR(9);5 
END; 


, 
/* 58: RWR */ 


DO; 
CALL SBS ISO: 
IF NOT SER(CURRENTSFLAG,2) THEN 
CALL FATALSERROR( #67); 
REWRITESPLAG=TRUE; 
CALL BACKSONESRECORD; 
IF NOT INVALID THEN CALL WRITES*ROMSMEMOR!Y; 
REWRITESFLAG=FALSE; 
CALL INCSPTR(9); 
END; 


е БӘБИ ря = 


ро; 
CALL SETSISO; 
IF NOT SHR(CURRENTSFLAG,2) THEN 
CALL FATALSERROR(/W6'); 
CALL SETSRANDOMSPOINTZE; 
REWRITESFLAG=TRUE; 
IF NOT INVALID TEEN 
CALL WRITESEMPTYSRECORD; 
REWRITESPLAG=FALS2; 
CALL INCSPTR(9); 
END; 


/* 60: MED */ 


DO; 
CALL MOVE(CSADDR(3),RES(CSADDR(0O)) 
‚CSkDDR(4)); 
BASE=RES(CSADDR(1)); 
HOLD=RES(CSADDR(GB)); 
(она: 
Cio, 
DO WHILE (CTR<CSADDR(2) )AND(CTR 
< C$ADDR'4)); 
CALL CHECKSEDIT(ESSYTE(O)); 
END; 
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IF CTR < CSADDR(4) THEN 
CALL FILL(HOLD,C$ADDR(4)-CTR," ^); 
CALL INCSPTR(12); 
END; 


/* 61: MNE */ 
! /* NULL CASE */ 


бе“ БОР #/ 


DO; 
DECLARE OFFSET BYTE; 
OFFSET=CONVERTSTOSHEX(CSADDR(1),CSBYTE(1)-1); 
IF OFFSET > CSBYITR(2) + 1 THEN 
DO; 
CALL PRINTSERROR( GD”); 
CALL INCSPTR(SHL(CSBYTE(@),1) + 5); 
END; 
ELSE PROGRAMSCOUNTER=CSADDR(OFFSET + 2); 
END; 


END; /* END OF CASE STATEMENT */ 
END; /* END OF DO FOREVER */ 
END EXECUTE; 


ne ee PROGRAM EMSCUTION STARTS HERS * * * */ 
BAS E=CODESSTART; 
PROGRAMS COUNTER=BSADDR(@); 


CALL EXECUTE: 
END; 
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READER: 
DO; 


/* COBOL COMPILER - PART 2 READER */ 


/* THIS PROGRAM IS LOADED IN WITH THE PART 1 PROGRAM 
AND IS CALLED WHEN PART 1 IS FINISHED. THIS PROGRAM 
OPENS THE PART2.COM FILE THAT CONTAINS THE CODE FOR 
PART 2 OF THE COMPILER, AND READS IT INTO CORR. AT 
THE END OF THE READ OPERATION, CONTROL IS PASSED TO 
THE SECOND PART PROGRAM. s 


/* 31008: LOAD POINT */ 
DECLARE 


START LITERALLY 71008, 

/* STARTING LOCATION FOR PART2 */ 
ADR ADDRESS INITIAL(START), 
moe (35) BYTE 
INITIAL( 98, “PART2 COM/,0,0,0,0,0,0,0,0, 
INITIAL(@, “PART2 сом“,0,27,0,0,2,0,2,8, 

POO ,0,0,0,0), 

I ADDRESS; 


Cpe sO pero 0 299 


MON1: PROCEDURE(F,A) EXTERNAL; 
DECLARE F BYTE, A ADDRESS; 
END MONI; 


MON2: PROCEDURE(F,A)BYTE EXTERNAL; 
DECLARE F BYTE, A ADDRESS; 
END MON2; 


POOT: PROCEDURE EXTERNAL; 
END; 


OPEN: PROCEDURE (FCB) BYTE; 
DECLARE FCE ADDRESS; 
RETURN MON2 (15, #08), 
END; 


READ: PROCEDURE (ADDR) BYTE; 
DECLARE ADDR ADDRESS; 
CALL MON1 (26, ADDR); /* SET DMA ADDRESS */ 
RETURN MON2 (28, .FCE); /* READ, AND RETURN 
EAROR CODR */ 
END; 


ERROR: PROCEDURE(CODE); 
DECLARE COLE ADDRESS; 
CALL MON1(2,(HIGH(CODE))); 
CALL MON1(2,(LOW(CODE))); 
CALL TIME( id); 
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CALL Е007; 
END ERROR; 
CALL MON1 (26, 91064); 


/* OPEN PASS2.COM */ 
I* OPEN(.FCB)2255 THEN CALL E&RROR('O2/); 
/* READ IN FILE */ 


I = 0100Н; ZS ODNDIIDOUDMADDRESS / 


DO WHILE READ(I) = 0; /* READ 1 SECTOR */ 
І = І + 908eH; /* BUMP DMA ADDRESS *%/ 
END; 
CALL MON1 (26, 90808); /* RESET DMA ADDRESS */ 
БАТТЫ ЧИН; 


END; 
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BUILD: 
po; 
/* NORMALLY ORG’ED AT 100H */ 


/* THIS PROGRAM TAKES THE CODE OUTPUT FROM THE COBOL 
COMPILER AND BUILDS THE ENVIRONMENT FOR THE COBOL 
INTERPRETER */ 


DECLARE 
LIT LITERALLY СЕТТЕ", 
BOOT LIT eo, 
BDOS ШЕТ EUN 
TRUE LIT 12752 
FALSE LIT СП. 
FOREVER LET “WHILE TRUE’, 
FCB ADDRESS ie Lee SCH), 
FCBSBYTE BASED FCB 87172, 
FCBSBYTESA BASED FCB (33) BYTE, 
I BYTE, 
ADDR ADDRESS INITIAL (1208), 
CHAR BASED ADDR BYTE, 
BUFFS END IIT "1005", 
INTERPSFCB (33) BYTE 
WAR O CINT eRe COM ,02,02,2,2), 
CODESNOTSSET BYTE INITIAL (TRUE), 
READERSLOCATION LIT “1C80H’, 
INTERPSADDRESS ADDRESS ІЧІТІАІ (20008), 
INTERPSCONTENT BASED INTERPSADDRESS ADDRESS, 
ISBYTE BASED INTERPSADDRESS (2) BYTE, 
CODESCTR ADDRESS, 
MSBYT E BASED CODESCTR BYTE, 
BASE ADDRESS, 
BS ADDR BASED BASE ADDRESS, 
BSBYTE BASED BASS (4) BYTE; 


MON1: PROCEDURE (F,A) EXTERNAL; 
DECLARE F EYTE, A ADDRESS; 
END MONI; 


MON2: PROCEDURE (F,A) BYTE EXTERNAL; 
DECLARE F BYTE, A ADDRESS, 
END MON2; 


PRINTSCHAR: PROCEDURZ(CHAR); 
DECLARE CHAR BYTE; 
CALL MON1(2,CHAR); 

END PRINTSCHAR; 


CRLF: PROCEDURE; 


gol 





CALL PRINTSCHAR(13); 
CALL PRINTSCEAR(10); 
END CRLF; 


PRINT: PROCEDURE (A); 
DECLARE A ADDRESS; 
CALL CRLF; 

CALL MON1(9,A); 

END PRINT; 


OPEN: PROCEDURE (A) BYTE; 
DECLARE A ADDRESS; 
RETURN MON2(15,A); 

END OPEN; 


REBOOT: PROCEDURE; 
ADDR = BOOT; CALL ADDR; 
END REBOOT; 


MOVE: PROCEDURE( FROM, DEST, COUNT); 
DECLARE (FROM, DEST, COUNT) ADDRESS, 
(F BASED FROM, D BASED DEST) BYTE; 
DO WHILE( COUNT: =COUNT—1 )<>OFFFFH; 
Г-Ұ; 
FROM=FROM+1; 
DEST=DEST+1; 
END; 
END MOVE, 


GETSCHAR: PROCEDURE BYTE; 
IF (ADDR:=ADDR + 1)>=BUFFSEND THEN 


DO; 
IF MON2(20,FCB)<>@ THEN 
DO; 
CALL PRINT(.('END OF INPUT zo), 
CALL REBOOT, 
END; 
ADDRz8eH; 
END; 


RETURN CHAR; 
END GETSCHAR; 


NEXTSCHAR: PROCEDURE; 
CHAR=GETSCHAR; 
SND NEXTSCHAR; 


STORE: PROCEDURE (COUNT) ; 
DECLARE COUNT BYTE; 
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IF CODESNOTSSET THEN 


DO; 
АР ИОС Зоте ERRORS ^)); 
CALL NEXTSCHAR; 
RETURN; 

END; 


ШЕГЕСІ TO COUNT: 
C$BYTE=CHAR; 
CALL NEXTSCHAR; 
SODESCTR=CODESCTR+1; 
END; 
END STORE; 


BACKSSTUFF: PROCEDURE; 
DECLARE HOLD. OTURE) ADDRESS; 
BASE=. HOLD; 

DOMI -o TO 3; 
BSBYTE(I)=GETSCHAR3 
END; 
DO FOREVER; 
BASE-HOLD; 
HOLD=BSADDR; 
BSADDR=STUFF; 
IF BOLD=@ THEN 
DO; 
CALL NEXTSCHAR; 
RETURN; 
END; 
END; 
END BACKSSTUFF3 


STARTSCODE: PROCEDURE; 
CODESNOTSSET=FALSE; 

mM uli 

ISBYTE(1)=GETSCHAR; 
CODESCTR=INTERPSCONTENT; 
CALL NEXTSCHAR; 

ЕМ) STARTSCODE; 


GOSDEPENDING: PROCEDURE; 
CASTO) 
ECHTE STORS(SHL(CHAR.1) + 4); 
END GOSDZPENDING;j 


INITIALIZE: PROCEDURE} 
DECLARE (COUNT, WEXRZE,HOWSMANY) ADDRESS; 
BASE=.WHERE; 
DO I=9 TO 3; 
B$SBITE(I)=GETSCHAR; 
END; 
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DO COUNT = 1 TO HOWSMANY; 
BSBYTE(COUNT)=GETSCHAR; 
END; 
CALL NEXTSCEAR; 
END INITIALIZE; 
BUILD: PROCEDURE; 
DECLARE 
1 пе 787. 
F3 Dame 97 
ПТ 21, 
25 ИШ 24, 
ПТ 32°, 
F? Рита Sc 
он LIT 49, 
КОКО ТТ 54. 
Wee birt. 60“, 
miS tits 61, 
GDA LIT ^62". 
ТИТ ОТТУ ЄЗ”, 
Bowe LIT “647, 
Rone T 65”. 
STP LIT 067, 
SCD "LIT 66. 
DO FOREVER; 
IF CHAR < F2 THEN CALL STOR?(1); 
ПИО CHAR < FS THEN CALL STORE(2); 
ПӘКТІК CHAR < P4 THENI CALL STORES); 
МС CHAR < FS THEN CALL STORS(4); 
LSE IF CHAR € F6 THEN CALL STORZ(5); 
Бен CHAR < P7? THEN CALL STORERÍO): 
ЕСЕ IF CEAR < 79 THENSCALL STORE(T); 
БЕТЕ СЕЛА С P1O THEN CALL STORE: 9); 
TLS2 IF CEA3 € F11 ^7HEN CALL STORE(12); 
RES IP CHAR < F13 TEN CALL STORE(11); 
ELSE IF CHAR < GDP THEN CALL STORE(13);3 
ELSE IF CHAS = GDP THEN CALL GOSDEPENDING; 
ПОСЕТЕ CHAR = BST THEN CALL BACKSSTUFF; 
ИЕ CHAR = INT THEN CALL INITIALIZE; 
ELSE IF CHAR = TER TEEN 
DO; 
CS3YTE = STP; 
CALL PRINT(.( “LOAD FINISHEDS’)); 
RETURN; 
END; 
eo e CHAR = SCD TEEN C£LL STARTÍCODO 
WESE DO; 
IF CHAR <> OFFE THEN 
CALL PRINT. (LOAD 56055 )); 
CALL NEXTSOHAR: 
217; 





END; 
END BUILD; 


/* PROGRAM EXECUTION STARTS HERE */ 


FCBSBYTESA(32) ,FCBSBYTE=@;3 

ПАТИ CIN, 0,0,0,0),FCB + 9,7); 

IF OPEN(FCB)=255 THEN 

DO; 
CALL PRINT(.( “FILE NOT FOUND ES 
САТ, ЕЕВООТ; 

END; 

CALL NEXTSCHAR; 

CALL BUILD; 

Crome MOV E( .INTERPSFCE,FCB,33); 

*C8$BYTESA(32) - 0j 

IF OPEN(FCB)=255 TEEN 

ШО; 
CALL PRINT(.( °INTERPRETSR NOT FOUND $'))3 
CLIE REBOOT; 

END; 

CALL MCVE(READERSLOCATION, 20H, 80H); 

ADDR = &@H; CALL ADDE; /* BRANCH TO 82H */ 

END; 
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INTRDR: /* NAME OF MODULE */ 
DO; 


/* COBOL COMPILER - INTERP READER */ 


/* THIS PROGRAM IS CALLED BY THE BUILD PROGRAM AFTER 
CINTERP.COM HAS BEEN OPENED, AND READS THE CODE INTO 


MEMORY */ 
/Ж _8ДЕ - LOAD POINT 207 
DECLARE 


START ПА ТЕ нон лане /* STARTING LOCATION BOR 
PART2 */ 

INTERP EDDRESSEMERDUTIAL(STARTO- 

I ADDRESS INITIAL (20808); 


MONA: PROCEDUREZ(F,A); 
DECLARE F BYTE, A ADDRESS; | | 
ASO TO L; AF PATCH TO -> JMP BDOS en 
END МОМА; 


MONB: PPOCEDURE(F,A)BYTE; 
DECLARE Y BYTE, A ADDRESS; | 
БИЕНІ | /5 РАТОН Т0-> JMP BDOS? */ 
RETURN 25 /* TAP -> NO-OP =) 
END MONB; 


DO wHILS 1; 
uns 25, CL:-TL-2980H)): 7* SET DMA ADDRESS */ 
IF MONB (29, SCH) <> @ THEN 
CALL INTZRP; 
END; 
*ND; 
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ШЕСОП DO; 


/* THIS PROGRAM TAKES THE CODE OUTPUT FPOM THE COBOL 
COMPILER AND CONVERTS IT INTO A READABLE OUTPUT TO 
FACILITATE DEBUGGING */ 


/* * * 100Н: LOAD POINT */ 

DFCLARE 

LIT LITERALLY ERTITERALLIY 
BOOT ТЕП Со, 

BDOS LIT Uc 

FCR ADDRESS INITIAL (SCH), 
FCB$BYTE BASED КОН 45) BYTES 

І Boe 

ADDR ADDRESS INITIAL (1003), 
BYTESCOUNT ADDRESS INITIAL (2), 
BYTES LOW ВҮТЕ, 

BYTESHI BIDS. 

CHAR BASED ADDED E: 

CSADDR BASED ADDR ADDRESS, 
BUFFSEND IIT ^OYFE', 
EILESTYPE (Ж) BYTE пао ДК“); 


MON1: PROCEDURE (F,A); 

pem c БЕТТЕ” АҒАТОЦЮ56; 

I MIC OE TOS ДЕ PATCH TO JMP S = 
3ND MONL; 


MON2: PROCEDURE (F,A) BYTE; 
DECLARE F BYTE, A ADDRESS; 


ee /ж ж ж РАТСН ТО " JMP5 " жож ж/ 
RETURN 9; 
7ND MON2; 


PRINTSCHAR: PROCEDURZ(CEAR); 
DECLARE CHAR БҮТҮҮ; 
CALL MON1(2,CHAR); 

END PRINTSCHAR; 


CRLF: PROCEDURE; 
CALL PRINTSCHAR(13); 
CALL PRINTSCHAR(19); 
END CRLF; 


P: PROCEDURE(ADD1); 
DECLARE ADDI ADDRESS, C BASED ADD1 (1) BYTE; 
CALL CRLF; 
DO 1=0 ТО 2; 
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CALL PPINTSCEAR(C(I)); 
END; 
СА1Т1, РВ1ТЧТ5СНАВ(^ ^J; 
BND P; 


GETSCHAR: PROCEDURE BYTE; 
IF (ADDR:=ADDE + 1)>BUFFSEND THEN 


DO; 
IF MON2(20,FCB)<>@ THEN 
DO; 
CALL De. END ’)); 
CALL TIME(19); . ч 
L: GO TO L; /* PATCH TO "JMP 2000" */ 
END; 
ADDR=80H; 
END} 


RETURN CHAR; 
END GETSCHAR; 


DSCHAR: PROCEDURE (OUTPUTSBYTE); 

DECLARE OUTPUTSBYTE BYTE; 

IF OUTPUTS BYTE<1@ TEEN 

CALL PRINTSCHAR(OUTPUTSBYTE + 30H); 

ELSE CALL PRINTSCHAR(OUTPUTSBYTS + 37H); 
ЕМІ Г5СНАЗ) 


D: PROCEDUFE (COUNT); 
DECLARE(COUNT,J) ADDRESS; 
DORI- L TOCOUNT; 
CALL DSCRAR(SER(GETSCHAR,4)); 
CALL DSCHAR(CHAR AND FH); 
CALL PRINTSCHAR(” 7); 
END; 
aD) Ds 


PRINTSREST: PROCEDURE; 
DECLAR? 
F2 INTUS. 
ои t9. 
F4 DIE ON 
A 
КЄ ни 327. 
F7 ite CSS. 
Dass 49, 
ЕЛ Ба, 
F11 20“, 
PLST LLU T el‘, 
СЇТ? ALIT 62°, 
INT 6356 
ВО ИТ 64, 
ПЛО Co, 
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ЭСЕ ES 


IF CHAR < F2 THEN RETUEN; 

IF CHAR < PS THEN DO; CALL D{1)3 RETURN; END; 
IF CHAR < F4 THEN DO; CALL D(2); RETURN; END; 
[PEG NANA DOS CALL D(3); RETURN; END; 
IE CHAR < T6 THEN DOF CALL D(4); RETURN; END; 
IF CHAR < F7 THEN DO; CALL D(5); RETURN; END; 
IF CEAR < F9 THEN DO; CALL D(6); RETURN; END; 
IF CHAR < F1@ THEN DC; CALL D(8); RETURN; END; 
IF CHAR < F11 THEN DO; CALL D(9); RETURN; END; 
IP ONAP < PIS AENT DO; CALL D(19); RETURN; END; 
IF CHAR < GDP THEN DO; CALL D(12); RETURN; END; 


IF CHAF=GDP THEN DO; 
CALL D(1); CALL D(SEL(CHAR,1)-5); RETURN; END; 
IF CHAR = INT THEN 
DO; 
BYTESCOUNT = @; 
(САТ ano); 
BYTESLOW = CHAR; 
CALL DI); 
BYTESHI = CHAR; 
BYTESCOUNT = BYTESHI; 
BYTESCOUNT = SHL(BYTESCOUNT,&) + BYTESLOW; 
(MLL D( BYTESCOUNT); 


RETURN; 
END; 
IP CHAR=BST THEN DO; CALL D(4);5 RETURN; END; 
IE CRHAR=TER THEN DO; CALL Р(.( 8 BND’); 
ССО /* PATCE TO JMP @ © ж %/ END; 
IF CHAR-SCT THEN DO; CALL D(2); RETURN; END; 
ІРГЕ OTFB THEN CALL ?P(.C(^XXY )); 


END PRINTSREST; 


/ PROGRAM EXECUTION STARTS HERE */ 


FCBSBYTE(32), FCBSBYTE(@) = g; 
DO I=9 TO 2; 

PCBS BYTS(1+9)=FILESTYPE(I1); 
END; 


Le MON2 ево у =255 THEN 00; САЉЉ Р(.(“722% )): 
L: GO TO L; EIND; 
/* * * * PATCH TO JMP BOOT ж ғ ж ж/ 


DO WHILE 1; 
IF GRTSCHA2 <= 66 THEN DO CASE CHAR; 
; /* CASE 89 NOT USED */ 


CALL a (ND) ys 
СОДИР С550в 5) ); 
CALL P(. (“MUL”) 


); 
ПАРО. (^DIT^))5 
ПАРО. 0 МЕС) ); 
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ron MEDO: 
CALL P(.( MNE); 
CALL P(.( GD? 7 
CALE Pt. (INT); 
(АТАРА РЦ а BST )); 
CALL P(C PER ak 
ПАРТ Ре, SED); 


END; /* OF CASE STATEMENT */ 
CALL PRINT$REST; 

END; /* END OF DO WHILE */ 

END; 
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